Changeset 2615 in project


Ignore:
Timestamp:
12/10/06 22:31:55 (14 years ago)
Author:
felix winkelmann
Message:

various updates, added records

Files:
14 added
46 edited

Legend:

Unmodified
Added
Removed

  • base64/base64.html

    r1255 r2615  
    1212
    1313<h3>Author:</h3>
    14 <a href="mailto:felix@call-with-current-continuation.org">felix</a>
     14James Bailey, ported to CHICKEN by <a href="mailto:felix@call-with-current-continuation.org">felix</a>
    1515
    1616<h3>Version:</h3>
    1717<ul>
     18<li>1.3
     19Replaced implementation which a much faster version by James Bailey
    1820<li>1.2
    1921removed read syntax
    … …  
    5355<h3>License:</h3>
    5456<pre>
    55 Copyright (c) 2003, Felix L. Winkelmann
    56 All rights reserved.
     57Copyright (c) 2004 James Bailey.
    5758
    58 Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
    59 conditions are met:
     59Permission is hereby granted, free of charge, to any person obtaining a
     60copy of this software and associated documentation files (the "Software"), to
     61deal in the Software without restriction, including without limitation the
     62rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
     63sell copies of the Software, and to permit persons to whom the Software is
     64furnished to do so, subject to the following conditions:
    6065
    61   Redistributions of source code must retain the above copyright notice, this list of conditions and the following
    62     disclaimer.
    63   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
    64     disclaimer in the documentation and/or other materials provided with the distribution.
    65   Neither the name of the author nor the names of its contributors may be used to endorse or promote
    66     products derived from this software without specific prior written permission.
     66The above copyright notice and this permission notice shall be included in all
     67copies or substantial portions of the Software.
    6768
    68 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
    69 OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
    70 AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
    71 CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
    72 CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
    73 SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
    74 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
    75 OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
    76 POSSIBILITY OF SUCH DAMAGE.
     69THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
     70IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
     71FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
     72AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
     73LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
     74OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
     75SOFTWARE.
    7776</pre>
    7877

  • base64/base64.meta

    r1255 r2615  
    66 (license "BSD")
    77 (files "base64.setup" "base64.scm" "base64.html")
    8  (author
    9    "<a href=\"mailto:felix@call-with-current-continuation.org\">felix</a>"))
     8 (author "James Bailey") )
     9

  • base64/base64.scm

    r1 r2615  
    1 ;;;; base64.scm - Support for base64 en-/de-coding - felix
    2 ;
    3 ; Copyright (c) 2000-2003, Felix L. Winkelmann
    4 ; All rights reserved.
    5 ;
    6 ; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
    7 ; conditions are met:
    8 ;
    9 ;   Redistributions of source code must retain the above copyright notice, this list of conditions and the following
    10 ;     disclaimer.
    11 ;   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
    12 ;     disclaimer in the documentation and/or other materials provided with the distribution.
    13 ;   Neither the name of the author nor the names of its contributors may be used to endorse or promote
    14 ;     products derived from this software without specific prior written permission.
    15 ;
    16 ; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
    17 ; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
    18 ; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
    19 ; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
    20 ; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
    21 ; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
    22 ; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
    23 ; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
    24 ; POSSIBILITY OF SUCH DAMAGE.
    25 ;
    26 ; Send bugs, suggestions and ideas to:
    27 ;
    28 ; felix@call-with-current-continuation.org
    29 ;
    30 ; Felix L. Winkelmann
    31 ; Steinweg 1A
    32 ; 37130 Gleichen, OT Weissenborn
    33 ; Germany
    34 ;
    35 ;
    36 ; [read syntax] #,(base64 STRING)
    37 ;   Reads a string that is decoded as base64 data.
    38 ;
    39 ; [procedure] (base64:encode STRING)
    40 ;   Returns STRING encoded as base64 text (a string).
    41 ;
    42 ; [procedure] (base64:decode STRING)
    43 ;   Returns the decoded string from the base64 data STRING.
    44 ;
    45 ;
    46 ; This should all be coded in C.
     1;; Copyright (c) 2004 James Bailey (dgym.REMOVE_THIS.bailey@gmail.com).
     2;;
     3;; Permission is hereby granted, free of charge, to any person obtaining a
     4;; copy of this software and associated documentation files (the "Software"), to
     5;; deal in the Software without restriction, including without limitation the
     6;; rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
     7;; sell copies of the Software, and to permit persons to whom the Software is
     8;; furnished to do so, subject to the following conditions:
     9;;
     10;; The above copyright notice and this permission notice shall be included in all
     11;; copies or substantial portions of the Software.
     12;;
     13;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
     14;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
     15;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
     16;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
     17;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
     18;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
     19;; SOFTWARE.
     20
     21;; base64 routines for bigloo, apart from the module info, bit routines, "when"
     22;; and fixed division "/fx" it should be slightly portable
     23
     24;; ported to CHICKEN by felix
     25
     26(declare
     27  (fixnum)
     28  (export base64:encode base64:decode) )
     29
     30(define base64:enc-table
     31  '#(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z
     32     #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z
     33     #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\+ #\/))
     34
     35;; easily generated by a macro, but this is more portable / understandable
     36(define base64:dec-table
     37  '#(0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0
     38     0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0
     39     0  0  0  0  0  0  0  0  0  0  0  62 0  0  0  63
     40     52 53 54 55 56 57 58 59 60 61 0  0  0  0  0  0
     41     0  0  1  2  3  4  5  6  7  8  9  10 11 12 13 14
     42     15 16 17 18 19 20 21 22 23 24 25 0  0  0  0  0
     43     0  26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
     44     41 42 43 44 45 46 47 48 49 50 51 0  0  0  0  0
     45     0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0
     46     0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0
     47     0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0
     48     0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0
     49     0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0
     50     0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0
     51     0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0
     52     0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0))
     53
     54;; the macro for the above
     55;;(define-macro (calc-dec)
     56;;  (let ((res (make-vector 256 0)))
     57;;    (do ((i 0 (+ i 1)))
     58;;      ((>= i 64))
     59;;      (vector-set! res (char->integer (vector-ref base64:enc-table i)) i))
     60;;    `(quote ,res)))
     61;;
     62;;(define base64:dec-table (calc-dec))
     63
     64(define (base64:encode str)
     65  (let* ((l (string-length str))
     66         (res (make-string (* 4 (fx/ (+ l 2) 3)) #\=))
     67         (bits-at (lambda
     68                    (idx) (char->integer (string-ref str idx)))))
     69
     70    (do ((i 0 (+ i 3))
     71         (o 0 (+ o 4))
     72         (remaining l (- remaining 3)))
     73      ((>= i l))
     74
     75      ;; take in 3 bytes, making a 24 bit integer
     76      ;; but this is done in steps depending on how many characters are remaining
     77      ;; always take one
     78      (let ((n (arithmetic-shift (bits-at i) 16)))
     79
     80        ;; take the second if there is one
     81        (if (> remaining 1)
     82          (set! n (bitwise-ior n (arithmetic-shift (bits-at (+ i 1)) 8))))
     83
     84        ;; write out the first two characters
     85        (string-set! res o (vector-ref base64:enc-table (bitwise-and (arithmetic-shift n -18) 63)))
     86        (string-set! res (+ o 1) (vector-ref base64:enc-table (bitwise-and (arithmetic-shift n -12) 63)))
     87
     88        (when (> remaining 1)
     89          ;; if there is a third, add that too, and write out the fourth result
     90          (when (> remaining 2)
     91            (set! n (bitwise-ior n (bits-at (+ i 2))))
     92            (string-set! res (+ o 3) (vector-ref base64:enc-table (bitwise-and n 63))))
     93         
     94          ;; write out the third result
     95          (string-set! res (+ o 2) (vector-ref base64:enc-table (bitwise-and (arithmetic-shift n -6) 63))))))
     96
     97    res))
    4798
    4899
    49 (declare (fixnum))
    50 
    51 (require 'extras)
    52 
    53 
    54 ;;; Encoding/Decoding:
    55 
    56 (define (base64:encode str)
    57   (define (enc n)
    58     (cond [(< n 26) (integer->char (+ (char->integer #\A) n))]
    59           [(< n 52) (integer->char (+ (char->integer #\a) (- n 26)))]
    60           [(< n 62) (integer->char (+ (char->integer #\0) (- n 52)))]
    61           [(= n 62) #\+]
    62           [else #\/] ) )
    63   (let* ([len (string-length str)]
    64          [lmax (- len (modulo len 3))]
    65          [out (open-output-string)] )
    66     (do ([i 0 (+ i 3)])
    67         ((>= i lmax)
    68          (case (modulo len 3)
    69            [(1)
    70             (let ([b1 (char->integer (string-ref str i))])
    71               (write-char (enc (arithmetic-shift (bitwise-and #b11111100 b1) -2)) out)
    72               (write-char (enc (arithmetic-shift (bitwise-and #b11 b1) 4)) out)
    73               (display "==" out) ) ]
    74            [(2)
    75             (let ([b1 (char->integer (string-ref str i))]
    76                   [b2 (char->integer (string-ref str (+ i 1)))] )
    77               (write-char (enc (arithmetic-shift (bitwise-and #b11111100 b1) -2)) out)
    78               (write-char
    79                (enc (bitwise-ior
    80                      (arithmetic-shift (bitwise-and #b11 b1) 4)
    81                      (arithmetic-shift (bitwise-and #b11110000 b2) -4) ) )
    82                out)
    83               (write-char (enc (arithmetic-shift (bitwise-and #b1111 b2) 2)) out)
    84               (write-char #\= out) ) ] )
    85          (get-output-string out) )
    86       (let ([b1 (char->integer (string-ref str i))]
    87             [b2 (char->integer (string-ref str (+ i 1)))]
    88             [b3 (char->integer (string-ref str (+ i 2)))] )
    89         (write-char (enc (arithmetic-shift (bitwise-and #b11111100 b1) -2)) out)
    90         (write-char
    91          (enc (bitwise-ior
    92                (arithmetic-shift (bitwise-and #b11 b1) 4)
    93                (arithmetic-shift (bitwise-and #b11110000 b2) -4) ) )
    94          out)
    95         (write-char
    96          (enc (bitwise-ior
    97                (arithmetic-shift (bitwise-and #b1111 b2) 2)
    98                (arithmetic-shift (bitwise-and #b11000000 b3) -6) ) )
    99          out)
    100         (write-char (enc (bitwise-and #b111111 b3)) out) ) ) ) )
    101100
    102101(define (base64:decode str)
    103   (define (dec c)
    104     (cond [(and (char>=? c #\0) (char<=? c #\9)) (+ (- (char->integer c) (char->integer #\0)) 52)]
    105           [(and (char>=? c #\A) (char<=? c #\Z)) (- (char->integer c) (char->integer #\A))]
    106           [(and (char>=? c #\a) (char<=? c #\z)) (+ (- (char->integer c) (char->integer #\a)) 26)]
    107           [(char=? c #\+) 62]
    108           [(char=? c #\/) 63]
    109           [(char=? c #\=) #f]
    110           [else #t] ) )
    111   (let ([out (open-output-string)]
    112         [len (string-length str)]
    113         [i 0] )
    114     (let loop ()
    115       (define (next)
    116         (let ([n (dec (string-ref str i))])
    117           (set! i (add1 i))
    118           (if (eq? #t n)
    119               (next)
    120               n) ) )
    121       (unless (>= i len)
    122         (unless (<= (+ i 4) len)
    123           (error "invalid base64 string - too short") )
    124         (let* ([n1 (next)]
    125                [n2 (next)]
    126                [n3 (next)]
    127                [n4 (next)] )
    128           (write-char
    129            (integer->char
    130             (bitwise-ior (arithmetic-shift n1 2)
    131                          (arithmetic-shift (bitwise-and #b110000 n2) -4) ) )
    132            out)
    133           (when n3
    134             (write-char
    135              (integer->char
    136               (bitwise-ior (arithmetic-shift (bitwise-and #b1111 n2) 4)
    137                            (arithmetic-shift (bitwise-and #b111100 n3) -2) ) )
    138              out)
    139             (when n4
    140               (write-char
    141                (integer->char
    142                 (bitwise-ior (arithmetic-shift (bitwise-and #b11 n3) 6) n4) )
    143                out) ) ) )
    144         (loop) ) )
    145     (get-output-string out) ) )
     102  (let* ((l (string-length str))
     103         (tmp (* 3 (fx/ l 4)))
     104         (res-l (cond
     105                  ((char=? (string-ref str (- l 2)) #\=)
     106                   (- tmp 2))
     107                  ((char=? (string-ref str (- l 1)) #\=)
     108                   (- tmp 1))
     109                  (else tmp)))
     110         (res (make-string res-l))
     111         (bits-at (lambda (idx)
     112                    (vector-ref base64:dec-table (char->integer (string-ref str idx))))))
     113
     114    (do ((i 0 (+ i 4))
     115         (o 0 (+ o 3))
     116         (remaining res-l (- remaining 3)))
     117      ((>= i l))
     118
     119      ;; take in 4 bytes, making a 24 bit integer
     120      (let ((n (bitwise-ior
     121                 (bitwise-ior (arithmetic-shift (bits-at i) 18)
     122                         (arithmetic-shift (bits-at (+ i 1)) 12))
     123                 (bitwise-ior (arithmetic-shift (bits-at (+ i 2)) 6)
     124                         (bits-at (+ i 3))))))
     125        ;; now write out 3 bytes at a time
     126        (string-set! res o (integer->char (bitwise-and (arithmetic-shift n -16) 255)))
     127        (when (> remaining 1)
     128          (string-set! res (+ o 1) (integer->char (bitwise-and (arithmetic-shift n -8) 255)))
     129          (when (> remaining 2)
     130            (string-set! res (+ o 2) (integer->char (bitwise-and n 255)))))))
     131
     132    res))
     133

  • base64/base64.setup

    r1255 r2615  
    1 (compile -s -O2 -d1 base64.scm)
    2 (install-extension 'base64 '("base64.html" "base64.so") '((version 1.2) (documentation "base64.html")))
     1(compile -s -O2 -d1 base64.scm -emit-exports base64.exports)
     2(install-extension
     3 'base64
     4 '("base64.html" "base64.so")
     5 '((version 1.3)
     6   (exports "base64.exports")
     7   (documentation "base64.html")))

  • bb/bb.html

    r1382 r2615  
    3939<h3>Version:</h3>
    4040<ul>
     41<li>1.20
     42Added proper check for FLTK installation [reported by Brandon Van Every]
    4143<li>1.19
    4244Adapted to externalized easyffi

  • bb/bb.setup

    r1382 r2615  
    11;;;; bb.setup -*- Scheme -*-
     2
     3(define (missing)
     4  (error "Sorry, FLTK (http://www.fltk.org) must be installed to use this extension") )
    25
    36(case (build-platform)
    47  [(msvc)
    5    (let ([fltk (or (getenv "FLTK") "")]
     8   (let ([fltk (or (getenv "FLTK")
     9                   (missing) )]
    610         [flu (getenv "FLU")])
    711     (make/proc
    … …  
    2428               ,(if flu (string-append "-L \"" flu "/lib/flulib.lib\"") "") ) ) )]
    2529  [(mingw32)
    26    (let ([fltk (or (getenv "FLTK") "")]
     30   (let ([fltk (or (getenv "FLTK")
     31                   (missing))]
    2732         [flu (getenv "FLU")])
    2833     (make/proc
    … …  
    6368                -ld g++) ) )] )
    6469
    65 (install-extension 'bb '("bb.so" "bb.html") '((version 1.19) (documentation "bb.html")))
     70(install-extension 'bb '("bb.so" "bb.html") '((version 1.20) (documentation "bb.html")))
    6671
    6772;;; vim: ft=scheme

  • chicken/Buildfile

    r2536 r2615  
    194194(install-man (dest MANDIR) "chicken.1" "csi.1" "csc.1" "chicken-profile.1" "chicken-setup.1")
    195195(install-file (dest INCDIR) "chicken.h" "chicken-defaults.h" "chicken-config.h")
    196 (install-file (dest DOCDIR) #;"ChangeLog" "README" "LICENSE")
     196(install-file (dest DOCDIR) "ChangeLog" "README" "LICENSE")
    197197(install-file (path (dest DOCDIR) "html") (glob "html/*") )
    198198
    … …  
    204204
    205205(notfile "doc")
    206 (actions "doc" ^{,CSI -s misc/makehtmldoc})
     206(depends "doc" "ChangeLog")
     207(actions "doc" ^{,CSI -s misc/makehtmldoc -pdf})
     208(actions "ChangeLog" ^{darcs changes >ChangeLog})
    207209
    208210(notfile "dist")

  • chicken/CMakeLists.txt

    r2443 r2615  
    4242#   CMake Useful Variables
    4343#   http://www.cmake.org/Wiki/CMake_Useful_Variables
    44 #   This is really important because the CMake 2.4.3 documentation
     44#   This is really important because the CMake 2.4.4 documentation
    4545#   does not document the variables that CMake uses, and there are
    4646#   quite a few of them.
    … …  
    9595# capabilities somewhere, and backwards compatibility is not assured.
    9696
    97 CMAKE_MINIMUM_REQUIRED(VERSION 2.4.3 FATAL_ERROR)
     97CMAKE_MINIMUM_REQUIRED(VERSION 2.4.4 FATAL_ERROR)
    9898
    9999# Bugs typically show up in the current version of CMake you're using.
    … …  
    105105#
    106106# To handle this, we need to know what version of CMake we're using.
    107 # We already issue a fatal error for any CMake less than 2.4.3.
     107# We already issue a fatal error for any CMake less than 2.4.4.
    108108# So this is sufficient for distinguishing whether we've got
    109 # CMake 2.4.3, or something greater.  We would ideally like to
     109# CMake 2.4.4, or something greater.  We would ideally like to
    110110# make lexical comparisons on CMake version numbers, and be able
    111111# to say things like "if it's greater than version 2.x.y, do this."
    112112# But that's work to implement, and this is easy and sufficient for now.
    113113
    114 SET(IS_CMAKE_243 false)
     114SET(IS_CMAKE_244 false)
    115115IF(CMAKE_MAJOR_VERSION EQUAL 2)
    116116  IF(CMAKE_MINOR_VERSION EQUAL 4)
    117     IF(CMAKE_PATCH_VERSION EQUAL 3)
    118       SET(IS_CMAKE_243 true)
    119     ENDIF(CMAKE_PATCH_VERSION EQUAL 3)
     117    IF(CMAKE_PATCH_VERSION EQUAL 4)
     118      SET(IS_CMAKE_244 true)
     119    ENDIF(CMAKE_PATCH_VERSION EQUAL 4)
    120120  ENDIF(CMAKE_MINOR_VERSION EQUAL 4)
    121121ENDIF(CMAKE_MAJOR_VERSION EQUAL 2)
    … …  
    322322ENDMACRO(LIST2STRING)
    323323
    324 # In CMake 2.4.2 under the MSYS generator, FILE(TO_NATIVE_PATH ...)
     324MACRO(UNESCAPE_WHITESPACE in out)
     325  # Remove escaped whitespace.  It causes some shells to choke.
     326  STRING(REPLACE "\\ " " " ${out} "${${in}}")
     327ENDMACRO(UNESCAPE_WHITESPACE)
     328
     329MACRO(ESCAPE_BACKSLASHES in out)
     330  STRING(REPLACE "\\" "\\\\" ${out} "${${in}}")
     331ENDMACRO(ESCAPE_BACKSLASHES)
     332
     333MACRO(ESCAPE_QUOTES in out)
     334  STRING(REPLACE "\"" "\\\"" ${out} "${${in}}")
     335ENDMACRO(ESCAPE_QUOTES)
     336
     337# Sometimes a standard Windows path is required, even on non-native
     338# system.  Use this to force it.
     339#
     340# NOTE: this code doesn't clean up MSYS or Cygwin drive letter
     341# conventions.  It will blithely turn /e/path or /cydrive/e/path
     342# into \e\path or \cygdrive\e\path.  If it were "done right," it
     343# would change both to E:\path.  But I'm too lazy right now.
     344# There are some corner cases, like /cygdrive, /cygdrive/, /e,
     345# e:/, e:, and so forth.
     346#
     347# Consequently, this code isn't actually useful.
     348
     349MACRO(UNQUOTED_WINDOWS_PATH cmake_path_in windows_path_out) 
     350  UNESCAPE_WHITESPACE(${cmake_path_in} ${windows_path_out})
     351  # Use backslashes for directory separation.
     352  STRING(REPLACE "/" "\\" ${windows_path_out} "${${windows_path_out}}")
     353ENDMACRO(UNQUOTED_WINDOWS_PATH)
     354
     355MACRO(WINDOWS_PATH cmake_path_in windows_path_out)
     356  UNQUOTED_WINDOWS_PATH(${cmake_path_in} ${windows_path_out})
     357  SET(${windows_path_out} \"${${windows_path_out}}\")
     358ENDMACRO(WINDOWS_PATH)
     359
     360# In CMake 2.4.4 under the MSYS generator, FILE(TO_NATIVE_PATH ...)
    325361# generates Unix style pathnames.  Although this may be correct behavior
    326362# under the MSYS shell itself, Chicken probably won't be used under the
    … …  
    329365
    330366MACRO(UNQUOTED_NATIVE_PATH cmake_path_in native_path_out)
    331   # Remove escaped whitespace.  It causes shells to choke.
    332   STRING(REPLACE "\\ " " " ${native_path_out} "${${cmake_path_in}}")
     367  # MSYS should be treated like a Windows native path, generally,
     368  # even though it understands Unix-style paths.
     369  # Cygwin should generally be treated like a Unix system.
    333370  IF(WIN32 AND NOT CYGWIN)
    334     # Use backslashes for directory separation.
    335     STRING(REPLACE "/" "\\" ${native_path_out} "${${native_path_out}}")
     371    UNQUOTED_WINDOWS_PATH(${cmake_path_in} ${native_path_out})
     372  ELSE(WIN32 AND NOT CYGWIN)
     373    UNESCAPE_WHITESPACE(${cmake_path_in} ${native_path_out})   
    336374  ENDIF(WIN32 AND NOT CYGWIN)
    337375ENDMACRO(UNQUOTED_NATIVE_PATH)
    … …  
    339377MACRO(NATIVE_PATH cmake_path_in native_path_out)
    340378  UNQUOTED_NATIVE_PATH(${cmake_path_in} ${native_path_out})
    341   # Quote the results
    342379  SET(${native_path_out} \"${${native_path_out}}\")
    343380ENDMACRO(NATIVE_PATH)
    … …  
    348385MACRO(NATIVE_C_PATH cmake_path_in native_path_out)
    349386  NATIVE_PATH(${cmake_path_in} ${native_path_out})
    350   # Need to escape backslashes
    351   STRING(REPLACE "\\" "\\\\" ${native_path_out} "${${native_path_out}}")
     387  # Don't escape quotes.  C compilers don't want that.
     388  ESCAPE_BACKSLASHES(${native_path_out} ${native_path_out})
    352389ENDMACRO(NATIVE_C_PATH)
    353 
    354 # CMake 2.4.3 has a bug where a COMMAND consumes twice the number of
    355 # escapes as an IF(...) statement!  This makes it impossible to
    356 # pass Windows native paths to a COMMAND.  Instead we must add
    357 # more escapes especially-and-only for the COMMAND.  This is filed
    358 # in the CMake bug tracker http:\\www.cmake.org\Bug as bug #3786.
    359 
    360 MACRO(NATIVE_COMMAND_EXE_PATH cmake_path_in native_path_out)
    361   NATIVE_PATH(${cmake_path_in} ${native_path_out})
    362   # Escape requirements seem to be specific to various generators.
    363   # MSVC generators seem to reduce all escapes down to a single backslash.
    364   # So, generating MSVC paths is easy.
    365   #
    366   # Not so for MSYS.  The actual executable in a COMMAND seems to need
    367   # excessive numbers of quotes.  And this differs again from what is
    368   # needed for command arguments and pipe redirections to files.  This
    369   # here just deals with the executable.
    370   IF(MINGW)
    371     # Really we mean MSYS, but there is no MSYS defined in CMake 2.4.3.
    372     #
    373     # Need to escape twice as many backslashes!
    374     STRING(REPLACE "\\" "\\\\\\\\" ${native_path_out} "${${native_path_out}}")
    375     # Quotes need to be escaped
    376     STRING(REPLACE "\"" "\\\"" ${native_path_out} "${${native_path_out}}")
    377   ENDIF(MINGW)
    378 ENDMACRO(NATIVE_COMMAND_EXE_PATH)
    379390
    380391
    … …  
    390401
    391402MACRO(ECHO_TARGET target quoted_message)
    392   # Sanity checking.  Unfortunately, it doesn't have the desired effect.
    393   # It won't catch code that isn't being exercised by the current
    394   # build settings.  So, a hapless user will receive any fatal errors,
    395   # not the developer, whose system is probably configured with all
    396   # needed tools and not calling ECHO_TARGET at all.
    397 
    398   # CMake 2.4.3 can't handle apostrophes in -E echo, even when
    399   # surrounded by double quotes.
    400   STRING(REGEX MATCH "'" CONTAINS_APOSTROPHE ${quoted_message})
    401   IF(CONTAINS_APOSTROPHE)
    402     MESSAGE(STATUS "CMake 2.4.3 cannot handle ' apostrophes in -E echo.")
    403   ENDIF(CONTAINS_APOSTROPHE)
    404  
    405   # The actual functionality
    406403  MESSAGE(STATUS ${quoted_message})
    407404  ADD_CUSTOM_TARGET(${target}
    … …  
    10091006####################################################################
    10101007
     1008# Sometimes you want to deduce a system property by compiling a piece
     1009# of code, running it, and seeing what the output does.  For instance,
     1010# you can detect the Endianness of a platform that way.  In fact,
     1011# running a code snippet is the only way to get it in general.  Some
     1012# definitions might be available in a *.h file somewhere, but that's
     1013# a platform specific solution.  Endianness is not actually a problem
     1014# in CMake as the TestBigEndian macro is available, but for other
     1015# odd things, you'll need to write your own tests.
     1016#
     1017# Such as the direction of stack growth!  The easiest approach is to
     1018# write a code snippet that returns a boolean value, 1 or 0.  Give it
     1019# a logical name like DoesWhatIWant.c.  Return 1 if it does what you
     1020# want, 0 if it doesn't.  Do a TRY_RUN, and receive this value through
     1021# the RUN_RESULT_VAR.  Use the RUN_RESULT_VAR later in your build,
     1022# to control whatever you need to control.
     1023#
     1024# When you want your TRY_RUN to just return a simple numerical result
     1025# code, you don't want to bother with OUTPUT_VARIABLE.  That's stdout;
     1026# you're going to get a lot of junk from the compiler reportage and
     1027# have to parse it.  That's a PITA and typically not what you want.
     1028#
     1029# The COMPILE_RESULT_VAR is just for diagnostics.  Like, does your
     1030# code even compile?  Is your code fine, but your shell is toast?
     1031# You use COMPILE_RESULT_VAR for bulletproofing, not for the results
     1032# you're actually interested in.
     1033
    10111034TRY_RUN(C_STACK_GROWS_DOWNWARD
    10121035  STACK_TEST_COMPILED
    … …  
    14191442  ADD_DEPENDENCIES(libuchicken libuchicken-c)
    14201443
     1444  SET_TARGET_PROPERTIES(libchicken PROPERTIES OUTPUT_NAME "chicken")
     1445  SET_TARGET_PROPERTIES(libuchicken PROPERTIES OUTPUT_NAME "uchicken")
    14211446  IF(CYGWIN)
    1422     SET_TARGET_PROPERTIES(libchicken PROPERTIES OUTPUT_NAME "chicken-0")
    1423     SET_TARGET_PROPERTIES(libuchicken PROPERTIES OUTPUT_NAME "uchicken-0")
    1424   ELSE(CYGWIN)
    1425     SET_TARGET_PROPERTIES(libchicken PROPERTIES OUTPUT_NAME "chicken")
    1426     SET_TARGET_PROPERTIES(libuchicken PROPERTIES OUTPUT_NAME "uchicken")
     1447    SET_TARGET_PROPERTIES(libchicken PROPERTIES VERSION 0)
     1448    SET_TARGET_PROPERTIES(libuchicken PROPERTIES VERSION 0)
    14271449  ENDIF(CYGWIN)
    14281450
    … …  
    15401562####################################################################
    15411563
    1542 # CMake 2.4.3 has a bug where shared and static libraries in the same
    1543 # directory clobber each other if they have the same rootname.  Also,
    1544 # if static and shared libraries are in the same directory, static
    1545 # exes will prefer to link with the shared libraries.  To work around
    1546 # these problems, we build all static libs and exes in a subdirectory.
     1564# CMake 2.4.4, by default, only allows a shared or a static library
     1565# of the same OUTPUT_NAME to be built in the same directory.  This is
     1566# enforced by clobbering all the .o files before building; I think
     1567# the last library specified is the winner.  This behavior can be
     1568# modified by using SET_TARGET_PROPERTIES to set CLEAN_DIRECT_OUTPUT
     1569# to 1.  However, this incurs a risk of linking against shared libs
     1570# when static libs are intended, and vice versa.  That's why the
     1571# default behavior is to clobber.
     1572#
     1573# To work around these problems, we build all static libs and exes
     1574# in a subdirectory.  Then there are no issues.
    15471575
    15481576ADD_SUBDIRECTORY(static)
    … …  
    15531581####################################################################
    15541582
    1555 # Note that as of Sept. 2nd, 2006, a Darcs package that understands
     1583# A distribution archive (aka a tarball) will have ChangeLog already.
     1584# A Darcs repository tree will not, however.  We have to generate it.
     1585#
     1586# Note that as of Nov. 22nd, 2006, a Darcs package that understands
    15561587# Cygwin paths is not readily available.  It is possible to compile
    15571588# Darcs from Haskell sources, but that requires GHC, which can be
    15581589# difficult to get working.  The upshot is it's a PITA to access
    1559 # Darcs from Cygwin and hence to create a ChangeLog.
    1560 #
    1561 # A distribution archive (aka a tarball) will have ChangeLog already.
    1562 # A Darcs repository tree will not, however.  We have to generate it.
     1590# Darcs from Cygwin and hence to create a ChangeLog.  It's possible,
     1591# but one has to proceed carefully.
     1592#
     1593# Different shells can cause Darcs to fail.  For instance, running a
     1594# Windows native Darcs under a Cygwin shell can fail, because the
     1595# Windows native Darcs doesn't understand Cygwin paths.  A workaround
     1596# is to avoid issuing any Cygwin path to Darcs, and instead use a
     1597# WORKING_DIRECTORY, so that CMake handles some of its own paths and
     1598# not Darcs.
    15631599#
    15641600# In principle, if we need to use a Darcs command, we should test
    1565 # whether Darcs is available and actually works.  Different shells
    1566 # can cause Darcs to fail.  For instance, running a Windows native
    1567 # Darcs under a Cygwin shell fails, because the Windows native Darcs
    1568 # doesn't understand Cygwin paths.
    1569 #
    1570 # In practice, it is very tedious to write a tool test in CMake 2.4.3.
    1571 # EXECUTE_PROCESS is not correct, as it executes in CMake's environment,
    1572 # not the actual build environment.  For instance, let's say Darcs is
    1573 # available at the Windows command prompt.  EXECUTE_PROCESS will say it
    1574 # works.  However, it won't actually work under Visual Studio, because
    1575 # VS doesn't typically receive all the paths that the command prompt does.
     1601# whether Darcs is available and actually works.  In practice, writing
     1602# reliable tool tests in CMake 2.4.4 is painful.
     1603#
     1604# You cannot use EXECUTE_PROCESS to write a tool test.  It executes in
     1605# CMake's environment, not the actual build environment.  For instance,
     1606# let's say Darcs is available at the Windows command prompt.
     1607# EXECUTE_PROCESS will say it works.  However, it won't actually work
     1608# under Visual Studio, because VS doesn't typically receive all the paths
     1609# that the command prompt does.
    15761610#
    15771611# To write a tool test, Kitware expects one to emit a trivial CMakeLists.txt
    1578 # to a temporary subdirectory, and then TRY_COMPILE it.  This turns out to
    1579 # be impossible to do in the general case, because in CMake 2.4.3 a
    1580 # COMMAND consumes twice as many escapes as it should.  The following is the
    1581 # the result of 3 days worth of workarounds.
     1612# to a temporary subdirectory, and then TRY_COMPILE it.  In practice, this
     1613# approach is exceedingly fragile, due to quote consumption problems with
     1614# FILE(WRITE ...) and with shells.
     1615#
     1616# What's really needed is an entirely different / better mechanism for
     1617# tool testing.  Something that's exactly parallel to the code we'd
     1618# write here at the toplevel, so that there are no weird extraneous
     1619# considerations.
    15821620
    15831621SET(CHANGELOG_FILE -NOTFOUND)
    … …  
    15861624  IF(DARCS_EXE)
    15871625    FILE(REMOVE_RECURSE ${CMAKE_CURRENT_BINARY_DIR}/try-darcs)
     1626
    15881627    # Note the need to escape any quotes that are part of the file output.
     1628    # I cannot figure out how to get code emitted in a file to quote properly.
     1629    # Consequently, we use a WORKING_DIRECTORY to duck the issue.
     1630    #
     1631    # Note that the \"${DARCS_EXE}\" quotes are necessary here, even though
     1632    # they are not generally necessary in the toplevel CMakeLists.txt, i.e.
     1633    # this file you're reading now.  At this level, whitespace is escaped, i.e.
     1634    #   ${DARCS_EXE} = E:/Program\ Files/darcsdir-w32
     1635    # But once emitted, the whitespace escapes are lost.  We get
     1636    #   ${DARCS_EXE} = E:/Program Files/darcsdir-w32
     1637    # and of course Cygwin dies, as E:/Program isn't a valid command.
     1638    #
     1639    # Possibly this emission code should be replaced with a CONFIGURE_FILE
     1640    # template.  Or else substitutions should be performed with
     1641    # STRING(CONFIGURE ...).  Anything to get the quote / escape problems
     1642    # under control.
     1643
    15891644    FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/try-darcs/CMakeLists.txt "
    15901645      PROJECT(try-darcs)
    15911646      ADD_CUSTOM_TARGET(try
    1592         WORKING_DIRECTORY ${Chicken_SOURCE_DIR}
     1647        WORKING_DIRECTORY \"${Chicken_SOURCE_DIR}\"
    15931648        COMMAND \"${DARCS_EXE}\" changes --last=0
    15941649      )
    … …  
    16061661      #   COMMAND command1 [args...]
    16071662      #
    1608       # command1 has to be a CMake path.  This is not documented in CMake 2.4.3.
     1663      # command1 has to be a CMake path.  This is not documented in CMake 2.4.4.
    16091664      # Think of command1 as receiving "special interpretation" and not really
    16101665      # being a "custom" command, i.e. you're not free to do what you like.
    16111666      #
    1612       # Also, command1 must be quoted as it may contain whitespace.  This is not
    1613       # a bug, but a common pitfall.  ADD_CUSTOM_COMMAND and ADD_CUSTOM_TARGET
    1614       # do not document this in CMake 2.4.3.  Hopefully later versions will.
     1667      # Also, if command1 is an absolute pathname, it must have whitespace
     1668      # handled properly.  The results of CMake Find* commands always have
     1669      # whitespace handled properly, but if you're homebrewing your own
     1670      # pathnames, be careful.
    16151671      #
    16161672      # Other path statements in [args...] need to be paths that your
    16171673      # tool understands.  This means you'll need native paths, unless your
    1618       # tool happens to like CMake paths.  In CMake 2.4.3, native paths are
    1619       # problematic as different generators do inconsistent things to quotes
    1620       # and escapes in the [args...].
     1674      # tool happens to like CMake paths.
    16211675      #
    1622       # We use a WORKING_DIRECTORY of ${Chicken_SOURCE_DIR} to avoid having to
    1623       # use --repodir=${Chicken_SOURCE_DIR}, as it comes out badly.
    1624       # ${NATIVE_CHANGELOG_FILE} is working on MSYS and MSVC, so we use it.
     1676      # As of November 22, 2006, there is no Cygwin version of Darcs.
     1677      # Instead, one typically has a Windows native version of
     1678      # Darcs running under a Cygwin shell.  This Windows native Darcs
     1679      # does not understand Cygwin paths, i.e. --repodir=/cygdrive/c/whatever
     1680      # will fail.
     1681      #
     1682      # Ideally, we'd complete the implementation of WINDOWS_PATH and provide
     1683      # proper paths.  Pragmatically, this is a PITA.  We adopt the expedient
     1684      # of using a working directory so that we don't have to bother with
     1685      # --repodir.
     1686      #
     1687      # stdout is redirected to the CHANGELOG_FILE.  Redirection is a shell
     1688      # operation, so we need a path that the shell understands.  Generally,
     1689      # keeping what a CMake comamnd1 needs, separate from what a tool needs,
     1690      # separate from what a shell needs, is confusing.  But that's the drill.
    16251691
    16261692      NATIVE_PATH(CHANGELOG_FILE NATIVE_CHANGELOG_FILE)
    … …  
    16321698
    16331699      ADD_CUSTOM_TARGET(darcs-changelog ALL
     1700        COMMENT "Generating ${NATIVE_CHANGELOG_FILE} from Darcs repository."
    16341701        WORKING_DIRECTORY ${Chicken_SOURCE_DIR}
    1635         COMMAND ${CMAKE_COMMAND} -E echo "Generating ${CHANGELOG_FILE} from Darcs repository."
    1636         COMMAND "${DARCS_EXE}" changes > ${NATIVE_CHANGELOG_FILE}
     1702        COMMAND ${DARCS_EXE} changes > ${NATIVE_CHANGELOG_FILE}
    16371703      )
    16381704    ELSE(DARCS_WORKS)
    … …  
    17341800ENDIF(WIN32)
    17351801
    1736 # CMake 2.4.3 can't produce both cygchicken-0.dll and libchicken.dll.a
    1737 # Currently Autoconf must produce the cygchicken-0.dll nomenclature,
    1738 # and that name is needed internally by the libraries for things to
    1739 # work correctly, so we can't ditch it in the source pool.  So we
    1740 # symlink it here.  This workaround courtesy of John Cowan.
    1741 
    1742 # Cygwin CMake 2.4.3 has "cmake -E create_symlink"
    1743 # Note that if this kind of workaround is ever needed on other
    1744 # platforms, some do not have symlinks.  For instance, MinGW / MSYS
    1745 # does not.  In that case a straight copy would be needed.
    1746 
    17471802# Brad King demonstrated \$ENV{DESTDIR} as the preferred method
    17481803# of handling ${CMAKE_INSTALL_PREFIX} when doing INSTALL(CODE ...)
    17491804# But I don't think this can be supported, as the paths must be
    17501805# hardwired into Chicken itself.
    1751 
    1752 IF(CYGWIN)
    1753   INSTALL(CODE "
    1754     MESSAGE(STATUS \"Symlinking libchicken-0.dll.a to libchicken.dll.a\")
    1755     EXECUTE_PROCESS(COMMAND \${CMAKE_COMMAND} -E remove
    1756       \"${LIB_HOME}/libchicken.dll.a\")
    1757     EXECUTE_PROCESS(COMMAND \${CMAKE_COMMAND} -E create_symlink
    1758       \"${LIB_HOME}/libchicken-0.dll.a\"
    1759       \"${LIB_HOME}/libchicken.dll.a\")
    1760     MESSAGE(STATUS \"Symlinking libuchicken-0.dll.a to libuchicken.dll.a\")
    1761     EXECUTE_PROCESS(COMMAND \${CMAKE_COMMAND} -E remove
    1762       \"${LIB_HOME}/libuchicken.dll.a\")
    1763     EXECUTE_PROCESS(COMMAND \${CMAKE_COMMAND} -E create_symlink
    1764       \"${LIB_HOME}/libuchicken-0.dll.a\"
    1765       \"${LIB_HOME}/libuchicken.dll.a\")
    1766   ")
    1767 ENDIF(CYGWIN)
    17681806
    17691807# Destination for eggs.  No eggs to install though.
    … …  
    19872025#
    19882026# The ADD_CUSTOM_TARGET bulletproofing is supposed to work, but doesn't!
    1989 # Found another bug in CMake 2.4.3; reported to Kitware.  When file
     2027# In CMake 2.4.4, when file
    19902028# dependencies of ADD_CUSTOM_TARGET are not built, the target nevertheless
    19912029# reports success.  So you can use these targets, but don't trust 'em when
    … …  
    20092047ADD_DEPENDENCIES(install-opengl-egg opengl-temp-dir chicken-setup)
    20102048
    2011 # In CMake 2.4.3 the following line crashes CMakeSetup!
    2012 # A bug report has been sent to Kitware.  Need to find out how to
    2013 # implement post-installation tests.
     2049# Kitware says "install" is not available as a first-class dependency,
     2050# and should not be used as such.
    20142051#
    20152052# ADD_DEPENDENCIES(install-opengl-egg install)

  • chicken/INSTALL-CMake.txt

    r1713 r2615  
    66---------------------------------------
    77
    8 last updated September 7, 2006
     8last updated November 21, 2006
    99
    1010If in trouble, please contact me through the Chicken mailing list.  You can subscribe to the list from the Chicken homepage, http://call-with-current-continuation.org.
    … …  
    111111-------------
    112112
    113 CMake 2.4.3 or later is required.  Goto http://www.cmake.org download section, grab CMake for your platform, and install it.  Alternately, if your OS has a packaging and distribution system (i.e. RedHat, Debian, Cygwin, etc.) you can probably obtain it that way.
     113CMake 2.4.4 or later is required.  Goto http://www.cmake.org download section, grab CMake for your platform, and install it.  Alternately, if your OS has a packaging and distribution system (i.e. RedHat, Debian, Cygwin, etc.) you can probably obtain it that way.
    114114
    115115

  • chicken/README

    r2536 r2615  
    33  (c)2000-2003 Felix L. Winkelmann
    44
    5   Version 2.506
     5  Version 2.508
    66
    77
    88 1. Introduction:
    99
    10         CHICKEN is a Scheme-to-C compiler supporting the language features as defined
    11         in the 'Revised^5 Report on Scheme'. Separate compilation is supported and
    12         full tail-recursion and efficient first-class continuations are available.
     10        CHICKEN is a Scheme-to-C compiler supporting the language
     11        features as defined in the 'Revised^5 Report on
     12        Scheme'. Separate compilation is supported and full
     13        tail-recursion and efficient first-class continuations are
     14        available.
    1315
    1416        Some things that CHICKEN has to offer:
    1517
    16         1. CHICKEN generates quite portable C code and compiled files generated by it
    17            (including itself) should work without any changes on DOS, Windows, most UNIX-like
    18            platforms, and with minor changes on other systems.
    19 
    20         2. The whole package is distributed under a BSD style license and as such is
    21            free to use and modify as long as you agree to its terms.
    22 
    23         3. Linkage to C modules and C library functions is straightforward. Compiled programs
    24            can easily be embedded into existing C code.
     18        1. CHICKEN generates quite portable C code and compiled files
     19           generated by it (including itself) should work without any
     20           changes on DOS, Windows, most UNIX-like platforms, and with
     21           minor changes on other systems.
     22
     23        2. The whole package is distributed under a BSD style license
     24           and as such is free to use and modify as long as you agree
     25           to its terms.
     26
     27        3. Linkage to C modules and C library functions is
     28           straightforward. Compiled programs can easily be embedded
     29           into existing C code.
    2530
    2631        4. Loads of extra libraries.
    2732
    28         Note: Should you have any trouble in setting up and using CHICKEN, please ask questions on
    29         the Chicken mailing list. You can subscribe to the list from the Chicken homepage,
     33        Note: Should you have any trouble in setting up and using
     34        CHICKEN, please ask questions on the Chicken mailing list. You
     35        can subscribe to the list from the Chicken homepage,
    3036        http://www.call-with-current-continuation.org)
    3137
    3238 2. Installation:
    3339
    34         First unzip the package ("unzip chicken-<version>.zip", "tar xvzf chicken-<version>.tar.gz"
    35         on UNIX or useyour favorite extraction program on Windows), then configure the system and
     40        First unzip the package ("unzip chicken-<version>.zip", "tar
     41        xvzf chicken-<version>.tar.gz" on UNIX or useyour favorite
     42        extraction program on Windows), then configure the system and
    3643        generate the binaries by invoking the "make" program.
    3744
    38         CHICKEN can be built either using the "CMake" <http://www.cmake.org> build system or
    39         via the traditional UNIX "configure/make/make install". On Windows it is generally
    40         recommended to use CMake. CMake offers more features than the autoconf build and is
    41         easier to maintain. See "INSTALL-CMake.txt" for detailed explanations about configuring,
    42         building and installing CHICKEN.
    43 
    44         If you prefer to use the autoconf generated build scripts, read on.
     45        CHICKEN can be built either using the "CMake"
     46        <http://www.cmake.org> build system or via the traditional
     47        UNIX "configure/make/make install". On Windows it is generally
     48        recommended to use CMake. CMake offers more features than the
     49        autoconf build and is easier to maintain. See
     50        "INSTALL-CMake.txt" for detailed explanations about
     51        configuring, building and installing CHICKEN.
     52
     53        If you prefer to use the autoconf generated build scripts,
     54        read on.
    4555
    4656        Linux, Mac OS X, UNIX and Cygwin:
    4757
    48           See INSTALL for generic instructions on how to pass different options to the
    49           configuration process. The default installation directories are /usr/local/bin,
    50           /usr/local/lib, /usr/local/include and /usr/local/share. Invoke
     58          See INSTALL for generic instructions on how to pass
     59          different options to the configuration process. The default
     60          installation directories are /usr/local/bin, /usr/local/lib,
     61          /usr/local/include and /usr/local/share. Invoke
    5162           
    5263            ./configure --prefix=<PATHNAME>
    … …  
    5970
    6071
    61           IMPORTANT ---> GNU make is required for building the system!!!
    62 
    63        
    64           This compiles the runtime-library, the compiler and the interpreter.
    65           To force creation of statically linked libraries and executables, Invoke
     72          IMPORTANT ---> GNU make is required for building the
     73          system!!!
     74
     75       
     76          This compiles the runtime-library, the compiler and the
     77          interpreter.  To force creation of statically linked
     78          libraries and executables, Invoke
    6679
    6780            ./configure --disable-shared
    6881
    69           Entering "make install-strip" instead of "make install" strips the executables from symbol-
    70           information which makes them much smaller.
    71 
    72           To make `apply' work, C function calls have to be constructed at run-time, which can not
    73           be portably implemented, unless using a big `switch' statement for every possible number
    74           of arguments. If the libffi library is available for this platform and if it is installed,
    75           then CHICKEN can take advantage of this to construct function calls for an (theoretical)
    76           unlimited number of arguments (currently there is an arbitrary limit of 1000 arguments
    77           maximum). To build CHICKEN with support for libffi, download and install libffi from
    78           http://sources.redhat.com/libffi/ before running "./configure".
    79           libffi is supposed to work on Mac OS X, many Linux systems (x86, Alpha, ARM, m68k, PPC) and
    80           Solaris.
    81 
    82           (Note: a more recent development snapshot of libffi is available at
    83           http://www.call-with-current-continuation.org/libffi-3.tgz).
    84           If you experience any problems with your libfi installation, you can disable support for it
    85           by passing "--without-libffi" to configure.
     82          Entering "make install-strip" instead of "make install"
     83          strips the executables from symbol- information which makes
     84          them much smaller.
     85
     86          To make `apply' work, C function calls have to be
     87          constructed at run-time, which can not be portably
     88          implemented, unless using a big `switch' statement for every
     89          possible number of arguments. If the libffi library is
     90          available for this platform and if it is installed, then
     91          CHICKEN can take advantage of this to construct function
     92          calls for an (theoretical) unlimited number of arguments
     93          (currently there is an arbitrary limit of 1000 arguments
     94          maximum). To build CHICKEN with support for libffi, download
     95          and install libffi from http://sources.redhat.com/libffi/
     96          before running "./configure".  libffi is supposed to work on
     97          Mac OS X, many Linux systems (x86, Alpha, ARM, m68k, PPC)
     98          and Solaris.
     99
     100          (Note: a more recent development snapshot of libffi is
     101          available at
     102          http://www.call-with-current-continuation.org/tarballs/libffi-3.tgz).
     103          If you experience any problems with your libfi installation,
     104          you can disable support for it by passing "--without-libffi"
     105          to configure.
    86106
    87107          To build and run some benchmarks, enter
    … …  
    89109            gmake bench
    90110
    91           It should be possible to build the system with Intel's C compiler (icc). Enter
     111          It should be possible to build the system with Intel's C
     112          compiler (icc). Enter
    92113         
    93114            ./configure --with-icc --disable-shared
    94115
    95           to compile all C files with icc. Note that shared libraries are not yet supported
    96           for this configuration.
    97 
    98           If you prefer to use Dorai Sitaram's PREGEXP regular expression package instead
    99           of the one in the C runtime library, add the option `--with-pregexp' to the
    100           invocation of "./configure". Note that PREGEXP is much slower.
    101 
    102           If you always want to enable garbage collection for unused symbols in the symbols table
    103           by default, pass the `-enable-symbol-gc' option to `configure'. This will result in slightly
    104           slower garbage collection, but minimizes the amount of garbage retained at runtime (which
    105           might be important for long running server applications). If you don't specify this option
    106           you can still enable symbol GC on a per-program basis by passing the `-:w' runtime option
    107           when running the program.
    108 
    109           If you want maximum performance, consider passing "--disable-apply-hook" to "configure",
    110           which will disable support for breakpoints, but speed up procedure invocation in safe
    111           code. Smaller binaries can be obtained by also giving "--disable-procedure-tables", but
    112           that means serialization (available separately) of procedures will not be available.
    113 
    114           A note for Mac OS X users: if you install the chicken runtime libraries (libchicken.*)
    115           into a non-standard directory, the dynamic linker might not be able to find them when
    116           executing chicken or programs generated by it. In that case you might want to set the
    117           environment variable DYLD_LIBRARY_PATH to the location where the libraries are installed.
    118 
    119           To remove CHICKEN from your file-system, enter (probably as root):
     116          to compile all C files with icc. Note that shared libraries
     117          are not yet supported for this configuration.
     118
     119          If you prefer to use Dorai Sitaram's PREGEXP regular
     120          expression package instead of the one in the C runtime
     121          library, add the option `--with-pregexp' to the invocation
     122          of "./configure". Note that PREGEXP is much slower.
     123
     124          If you always want to enable garbage collection for unused
     125          symbols in the symbols table by default, pass the
     126          `-enable-symbol-gc' option to `configure'. This will result
     127          in slightly slower garbage collection, but minimizes the
     128          amount of garbage retained at runtime (which might be
     129          important for long running server applications). If you
     130          don't specify this option you can still enable symbol GC on
     131          a per-program basis by passing the `-:w' runtime option when
     132          running the program.
     133
     134          If you want maximum performance, consider passing
     135          "--disable-apply-hook" to "configure", which will disable
     136          support for breakpoints, but speed up procedure invocation
     137          in safe code. Smaller binaries can be obtained by also
     138          giving "--disable-procedure-tables", but that means
     139          serialization (available separately) of procedures will not
     140          be available.
     141
     142          A note for Mac OS X users: if you install the chicken
     143          runtime libraries (libchicken.*) into a non-standard
     144          directory, the dynamic linker might not be able to find them
     145          when executing chicken or programs generated by it. In that
     146          case you might want to set the environment variable
     147          DYLD_LIBRARY_PATH to the location where the libraries are
     148          installed.
     149
     150          To remove CHICKEN from your file-system, enter (probably as
     151          root):
    120152
    121153            make uninstall
    122154
    123         Windows binary distribution:
    124 
    125           Unpack chicken-<version>-msvc.zip into "C:\Program Files\" and add "C:\Program Files\bin"
    126           into your %PATH%.
    127 
    128         Mac OS X binary distribution:
    129 
    130           Unpack chicken-<version>-osx-ppc.dmg and install the contained ".pkg" file. It will place
    131           binaries, libraries and support-files under "/usr".
    132 
    133 
    134155 3. Usage:
    135156
    136         Documentation can be found in the directory <prefix>/share/chicken/doc, where <prefix>
    137         is the prefix specified in the `--prefix' option to `configure', which defaults to
    138         `/usr/local'. The HTML documentation (in "<prefix>/share/chicken/doc/html") is automatically
    139         generated from the Wiki pages at <http://chicken.wiki.br/>. Go there to read the
    140         most up to date documentation.
    141 
    142         An emacs mode is provided in the file `hen.el'. To use it, copy it somewhere into a location
    143         you normally use for emacs extensions. If you want to add a specific location permanently to
    144         the list of paths emacs should search for extensions, add the following line to your
    145         `.emacs' file:
    146 
    147           (setq load-path (cons "<directory-where-your-emacs-lisp-files-live>" load-path))
     157        Documentation can be found in the directory
     158        <prefix>/share/chicken/doc, where <prefix> is the prefix
     159        specified in the `--prefix' option to `configure', which
     160        defaults to `/usr/local'. The HTML documentation (in
     161        "<prefix>/share/chicken/doc/html") is automatically generated
     162        from the Wiki pages at <http://chicken.wiki.br/>. Go there to
     163        read the most up to date documentation.
     164
     165        An emacs mode is provided in the file `hen.el'. To use it,
     166        copy it somewhere into a location you normally use for emacs
     167        extensions. If you want to add a specific location permanently
     168        to the list of paths emacs should search for extensions, add
     169        the following line to your `.emacs' file:
     170
     171          (setq load-path (cons
     172          "<directory-where-your-emacs-lisp-files-live>" load-path))
    148173
    149174        Add
    … …  
    151176          (require 'hen)
    152177       
    153         To make "hen-mode" available, and enter it by issuing the command M-x hen-mode.
     178        To make "hen-mode" available, and enter it by issuing the
     179        command M-x hen-mode.
    154180
    155181
    156182 4. Extension:
    157183
    158         A large number of extension libraries for CHICKEN are available at
    159         <http://www.call-with-current-continuation.org/eggs/>. You can automatically download, compile
    160         and install extensions with the "chicken-setup" program. See the CHICKEN User's Manual for
     184        A large number of extension libraries for CHICKEN are
     185        available at
     186        <http://www.call-with-current-continuation.org/eggs/>. You can
     187        automatically download, compile and install extensions with
     188        the "chicken-setup" program. See the CHICKEN User's Manual for
    161189        more information.
    162190
    163         Windows users: Note that you must have "tar" and "gunzip" programs installed and available through
    164         the "PATH" environment variable to extract extensions. If you don't download and extract the
    165         extensions ("eggs") manually using a browser and the decompression program of your choice and
    166         run "chicken-setup" in the directory where you extracted the extension archive.
     191        Windows users: Note that you must have "tar" and "gunzip"
     192        programs installed and available through the "PATH"
     193        environment variable to extract extensions. If you don't
     194        download and extract the extensions ("eggs") manually using a
     195        browser and the decompression program of your choice and run
     196        "chicken-setup" in the directory where you extracted the
     197        extension archive.
     198
     199        Windows binaries for common UNIX utilities (most notably "tar"
     200        and "gunzip") are available here:
     201        <http://www.call-with-current-continuation.org/tarballs/UnxUtils.zip>.
     202
     203        A selection of 3rd party libraries, together with source and
     204        binary packages for tools helpful for development with CHICKEN
     205        are also available at:
     206        <http://www.call-with-current-continuation.org/tarballs/>.
    167207
    168208       
    169209 5. Platform issues:
    170210
    171         - Some old Linux distributions ship with a buggy version of the GNU C compiler (2.96). If the
    172           system is configured for kernel recompilation, then an alternative GCC version is available under
    173           the name `kgcc' (GCC 2.96 can not recompile the kernel). CHICKEN's configuration script should
    174           normally be able to handle this problem, but you have to remember to compile your translated
    175           Scheme files with `kgcc' instead of `gcc'.
    176 
    177         - There seems to be a problem with the GNU linker on HP/PA systems. In this case it is recommended to
    178           use the HP linker. If not available, try to add `-ffunction-sections' to the gcc compiler flags.
    179 
    180         - Older versions of Solaris have a bug in ld.so that causes trouble with dynamic loading.
    181           Patching Solaris fixes the problem. Solaris 7 needs patch 106950-18. Solaris 8 has an
     211        - Some old Linux distributions ship with a buggy version of
     212          the GNU C compiler (2.96). If the system is configured for
     213          kernel recompilation, then an alternative GCC version is
     214          available under the name `kgcc' (GCC 2.96 can not recompile
     215          the kernel). CHICKEN's configuration script should normally
     216          be able to handle this problem, but you have to remember to
     217          compile your translated Scheme files with `kgcc' instead of
     218          `gcc'.
     219
     220        - There seems to be a problem with the GNU linker on HP/PA
     221          systems. In this case it is recommended to use the HP
     222          linker. If not available, try to add `-ffunction-sections'
     223          to the gcc compiler flags.
     224
     225        - Older versions of Solaris have a bug in ld.so that causes
     226          trouble with dynamic loading.  Patching Solaris fixes the
     227          problem. Solaris 7 needs patch 106950-18. Solaris 8 has an
    182228          equivalent patch, 109147-16.
    183229
    184           You can find out if you have these patches installed by running:
     230          You can find out if you have these patches installed by
     231          running:
    185232
    186233          % showrev -p | grep 106950    # solaris 7
    187234          % showrev -p | grep 109147    # solaris 8
    188235
    189         - On NetBSD it might be possible that compilation fails with a "virtual memory exhausted error".
    190           Try the following:
     236        - On NetBSD it might be possible that compilation fails with a
     237          "virtual memory exhausted error".  Try the following:
    191238
    192239          % unlimit datasize
    193240
    194         - For Mac OS X, Chicken requires libdl, for loading compiled code dynamically. This library is
    195           available on Mac OS X 10.4 (Tiger) by default. For older version ou can find it here:
     241        - For Mac OS X, Chicken requires libdl, for loading compiled
     242          code dynamically. This library is available on Mac OS X 10.4
     243          (Tiger) by default. For older version ou can find it here:
    196244
    197245            http://www.opendarwin.org/projects/dlcompat
    … …  
    202250           easyffi.c:18697: warning: `noreturn' function does return
    203251       
    204           when compiling the system or compiled Scheme files. These warnings are bogus and can be
    205           ignored.
     252          when compiling the system or compiled Scheme files. These
     253          warnings are bogus and can be ignored.
    206254
    207255
    208256 5. What's next?
    209257
    210         If you have any more questions or problems (even the slightest problems, or the most
    211         stupid questions), then please contact me at:
     258        If you have any more questions or problems (even the slightest
     259        problems, or the most stupid questions), then please contact
     260        me at:
    212261
    213262        <felix@call-with-current-continuation.org>.

  • chicken/build.scm

    r2536 r2615  
    1 (define-constant +build-version+ "2.506")
     1(define-constant +build-version+ "2.508")

  • chicken/buildversion

    r2536 r2615  
    1 2.506
     12.508

  • chicken/chicken-more-macros.scm

    r2488 r2615  
    8787         (##sys#check-syntax 'receive vars 'lambda-list)
    8888         (##sys#check-syntax 'receive rest '(_ . _))
    89          `(##sys#call-with-values
    90            (lambda () ,(car rest))
    91            (lambda ,vars ,@(cdr rest)) ) ) ) ) )
     89         (if (and (pair? vars) (null? (cdr vars)))
     90             `(let ((,(car vars) ,(car rest)))
     91                ,@(cdr rest))
     92             `(##sys#call-with-values
     93               (lambda () ,(car rest))
     94               (lambda ,vars ,@(cdr rest)) ) ) ) ) ) )
    9295
    9396(##sys#register-macro
    … …  
    233236   `(if ,test (##core#undefined) (begin ,@body)) ) )
    234237
    235 (let* ([map map]
    236        [assign
     238(let* ((map map)
     239       (assign
    237240        (lambda (vars exp)
    238241          (##sys#check-syntax 'set!-values/define-values vars '#(symbol 0))
    239           (if (null? vars)
    240               `(##sys#call-with-values (lambda () ,exp) (lambda () (##core#undefined)))
    241               (let ([aliases (map gensym vars)])
    242                 `(##sys#call-with-values
    243                   (lambda () ,exp)
    244                   (lambda ,aliases
    245                     ,@(map (lambda (v a) `(##core#set! ,v ,a)) vars aliases) ) ) ) ) ) ] )
     242          (cond ((null? vars)
     243                 ;; may this be simply "exp"?
     244                 `(##sys#call-with-values (lambda () ,exp) (lambda () (##core#undefined))) )
     245                ((null? (cdr vars))
     246                 `(##core#set! ,(car vars) ,exp))
     247                (else
     248                 (let ([aliases (map gensym vars)])
     249                   `(##sys#call-with-values
     250                     (lambda () ,exp)
     251                     (lambda ,aliases
     252                       ,@(map (lambda (v a) `(##core#set! ,v ,a)) vars aliases) ) ) ) ) ) ) ) )
    246253  (##sys#register-macro 'set!-values assign)
    247254  (##sys#register-macro 'define-values assign) )
    … …  
    285292                  [exps (map (lambda (x) (cadr x)) vbindings)]
    286293                  [llists2 llists2] )
    287          (if (null? llists)
    288              `(let ,(map (lambda (v) (##sys#list v (lookup v))) vars) ,@body)
    289              `(##sys#call-with-values (lambda () ,(car exps))
    290                                       (lambda ,(car llists2) ,(fold (cdr llists) (cdr exps) (cdr llists2))) ) ) ) ) ) ) )
     294         (cond ((null? llists)
     295                `(let ,(map (lambda (v) (##sys#list v (lookup v))) vars) ,@body) )
     296               ((and (pair? (car llists2)) (null? (cdar llists2)))
     297                `(let (,(caar llists2) ,(car exps))
     298                   ,(fold (cdr llists) (cdr exps) (cdr llists2)) ) )
     299               (else
     300                `(##sys#call-with-values
     301                  (lambda () ,(car exps))
     302                  (lambda ,(car llists2) ,(fold (cdr llists) (cdr exps) (cdr llists2))) ) ) ) ) ) ) ) )
    291303
    292304(##sys#register-macro-2

  • chicken/chicken.scm

    r1713 r2615  
    8080  (include "chicken-ffi-macros") )
    8181
    82 (##sys#provide 'extras 'srfi-1 'srfi-4)
     82;;(##sys#provide 'extras 'srfi-1 'srfi-4)
    8383
    8484

  • chicken/compiler.scm

    r2248 r2615  
    617617                                         (list alias (walk (cadr b) ae me (car b))) )
    618618                                       aliases bindings)
    619                               ,(walk (##sys#canonicalize-body (cddr x) (cut assq <> ae2) me)
     619                              ,(walk (##sys#canonicalize-body (cddr x) (cut assq <> ae2) me dest)
    620620                                     ae2
    621621                                     me dest) ) ) )
    … …  
    638638                                     [body
    639639                                      (walk
    640                                        (##sys#canonicalize-body obody (cut assq <> ae2) me)
     640                                       (##sys#canonicalize-body obody (cut assq <> ae2) me dest)
    641641                                       ae2
    642642                                       me #f) ]
    … …  
    660660                                [body
    661661                                 (walk
    662                                   (##sys#canonicalize-body obody (cut assq <> ae2) me)
     662                                  (##sys#canonicalize-body obody (cut assq <> ae2) me dest)
    663663                                  ae2
    664664                                  me #f) ] )

  • chicken/cscbench.scm

    r2488 r2615  
    2020        (if (eof-object? line)
    2121            (abort-run)
    22             (let ([m (string-match " *([-+e0-9]*(\\.[0-9]*)?) seconds elapsed" line)])
     22            (let ([m (string-match " *([-.+e0-9]*(\\.[0-9]*)?) seconds elapsed" line)])
    2323              (if m
    2424                  (string->number (second m))

  • chicken/csi.scm

    r2536 r2615  
    589589                                (fprintf out " ~S: ~S" i v)
    590590                                (if (fx> n 1)
    591                                     (fprintf out "\t(followed by ~A identical instances)~% ...~%" n)
     591                                    (fprintf out "\t(followed by ~A identical instances)~% ...~%" (fx- n 1))
    592592                                    (newline out) )
    593593                                (loop1 (fx+ i n)) )

  • chicken/eval.scm

    r2536 r2615  
    395395  (let ([reverse reverse]
    396396        [map map] )
    397     (lambda (body lookup . me)
    398       (let ([me (:optional me '())])
    399         (define (fini vars vals mvars mvals body)
    400           (if (and (null? vars) (null? mvars))
    401               (let loop ([body2 body] [exps '()])
    402                 (if (not (pair? body2))
    403                     `(begin ,@body)     ; no more defines, otherwise we would have called `expand'
    404                     (let ([x (##sys#slot body2 0)])
    405                       (if (and (pair? x) (memq (##sys#slot x 0) `(define define-values)))
    406                           `(begin . ,(##sys#append (reverse exps) (list (expand body2))))
    407                           (loop (##sys#slot body2 1) (cons x exps)) ) ) ) )
    408               (let ([vars (reverse vars)])
    409                 `(let ,(##sys#map (lambda (v) (##sys#list v (##sys#list '##core#undefined)))
    410                                   (apply ##sys#append vars mvars) )
    411                    ,@(map (lambda (v x) `(##core#set! ,v ,x)) vars (reverse vals))
    412                    ,@(map (lambda (vs x)
    413                             (let ([tmps (##sys#map gensym vs)])
    414                               `(##sys#call-with-values
    415                                 (lambda () ,x)
    416                                 (lambda ,tmps
    417                                   ,@(map (lambda (v t) `(##core#set! ,v ,t)) vs tmps) ) ) ) )
    418                           (reverse mvars)
    419                           (reverse mvals) )
    420                    ,@body) ) ) )
    421         (define (expand body)
    422           (let loop ([body body] [vars '()] [vals '()] [mvars '()] [mvals '()])
    423             (if (not (pair? body))
    424                 (fini vars vals mvars mvals body)
    425                 (let* ([x (##sys#slot body 0)]
    426                        [rest (##sys#slot body 1)]
    427                        [head (and (pair? x) (##sys#slot x 0))] )
    428                   (cond [(not head) (fini vars vals mvars mvals body)]
    429                         [(and (symbol? head) (lookup head))
    430                          (fini vars vals mvars mvals body) ]
    431                         [(eq? 'define head)
    432                          (##sys#check-syntax 'define x '(define _ . #(_ 0)) #f)
    433                          (let loop2 ([x x])
    434                            (let ([head (cadr x)])
    435                              (cond [(not (pair? head))
    436                                     (##sys#check-syntax 'define x '(define variable . #(_ 0)) #f)
    437                                     (loop rest (cons head vars)
    438                                           (cons (if (pair? (cddr x))
    439                                                     (caddr x)
    440                                                     '(##sys#void) )
    441                                                 vals)
    442                                           mvars mvals) ]
    443                                    [(pair? (##sys#slot head 0))
    444                                     (##sys#check-syntax 'define x '(define (_ . lambda-list) . #(_ 1)) #f)
    445                                     (loop2 (cons 'define (##sys#expand-curried-define head (cddr x)))) ]
    446                                    [else
    447                                     (##sys#check-syntax 'define x '(define (variable . lambda-list) . #(_ 1)) #f)
    448                                     (loop rest
    449                                           (cons (##sys#slot head 0) vars)
    450                                           (cons `(lambda ,(##sys#slot head 1) ,@(cddr x)) vals)
    451                                           mvars mvals) ] ) ) ) ]
    452                         [(eq? 'define-values head)
    453                          (##sys#check-syntax 'define-values x '(define-values #(_ 0) _) #f)
    454                          (loop rest vars vals (cons (cadr x) mvars) (cons (caddr x) mvals)) ]
    455                         [(eq? 'begin head)
    456                          (##sys#check-syntax 'begin x '(begin . #(_ 0)) #f)
    457                          (loop (##sys#append (##sys#slot x 1) rest) vars vals mvars mvals) ]
    458                         [else
    459                          (let ([x2 (##sys#macroexpand-0 x me)])
    460                            (if (eq? x x2)
    461                                (fini vars vals mvars mvals body)
    462                                (loop (cons x2 rest) vars vals mvars mvals) ) ) ] ) ) ) ) )
    463         (expand body) ) ) ) )
     397    (lambda (body lookup #!optional me container)
     398      (define (fini vars vals mvars mvals body)
     399        (if (and (null? vars) (null? mvars))
     400            (let loop ([body2 body] [exps '()])
     401              (if (not (pair? body2))
     402                  `(begin ,@body) ; no more defines, otherwise we would have called `expand'
     403                  (let ([x (##sys#slot body2 0)])
     404                    (if (and (pair? x) (memq (##sys#slot x 0) `(define define-values)))
     405                        `(begin . ,(##sys#append (reverse exps) (list (expand body2))))
     406                        (loop (##sys#slot body2 1) (cons x exps)) ) ) ) )
     407            (let ([vars (reverse vars)])
     408              `(let ,(##sys#map (lambda (v) (##sys#list v (##sys#list '##core#undefined)))
     409                                (apply ##sys#append vars mvars) )
     410                 ,@(map (lambda (v x) `(##core#set! ,v ,x)) vars (reverse vals))
     411                 ,@(map (lambda (vs x)
     412                          (let ([tmps (##sys#map gensym vs)])
     413                            `(##sys#call-with-values
     414                              (lambda () ,x)
     415                              (lambda ,tmps
     416                                ,@(map (lambda (v t) `(##core#set! ,v ,t)) vs tmps) ) ) ) )
     417                        (reverse mvars)
     418                        (reverse mvals) )
     419                 ,@body) ) ) )
     420      (define (expand body)
     421        (let loop ([body body] [vars '()] [vals '()] [mvars '()] [mvals '()])
     422          (if (not (pair? body))
     423              (fini vars vals mvars mvals body)
     424              (let* ([x (##sys#slot body 0)]
     425                     [rest (##sys#slot body 1)]
     426                     [head (and (pair? x) (##sys#slot x 0))] )
     427                (cond [(not head) (fini vars vals mvars mvals body)]
     428                      [(and (symbol? head) (lookup head))
     429                       (fini vars vals mvars mvals body) ]
     430                      [(eq? 'define head)
     431                       (##sys#check-syntax 'define x '(define _ . #(_ 0)) #f)
     432                       (let loop2 ([x x])
     433                         (let ([head (cadr x)])
     434                           (cond [(not (pair? head))
     435                                  (##sys#check-syntax 'define x '(define variable . #(_ 0)) #f)
     436                                  (loop rest (cons head vars)
     437                                        (cons (if (pair? (cddr x))
     438                                                  (caddr x)
     439                                                  '(##sys#void) )
     440                                              vals)
     441                                        mvars mvals) ]
     442                                 [(pair? (##sys#slot head 0))
     443                                  (##sys#check-syntax 'define x '(define (_ . lambda-list) . #(_ 1)) #f)
     444                                  (loop2 (cons 'define (##sys#expand-curried-define head (cddr x)))) ]
     445                                 [else
     446                                  (##sys#check-syntax 'define x '(define (variable . lambda-list) . #(_ 1)) #f)
     447                                  (loop rest
     448                                        (cons (##sys#slot head 0) vars)
     449                                        (cons `(lambda ,(##sys#slot head 1) ,@(cddr x)) vals)
     450                                        mvars mvals) ] ) ) ) ]
     451                      [(eq? 'define-values head)
     452                       (##sys#check-syntax 'define-values x '(define-values #(_ 0) _) #f)
     453                       (loop rest vars vals (cons (cadr x) mvars) (cons (caddr x) mvals)) ]
     454                      [(eq? 'begin head)
     455                       (##sys#check-syntax 'begin x '(begin . #(_ 0)) #f)
     456                       (loop (##sys#append (##sys#slot x 1) rest) vars vals mvars mvals) ]
     457                      [else
     458                       (let ([x2 (##sys#macroexpand-0 x me)])
     459                         (if (eq? x x2)
     460                             (fini vars vals mvars mvals body)
     461                             (loop (cons x2 rest) vars vals mvars mvals) ) ) ] ) ) ) ) )
     462      (expand body) ) ) )
    464463
    465464
    … …  
    765764                                     [e2 (cons vars e)]
    766765                                     [body (##sys#compile-to-closure
    767                                             (##sys#canonicalize-body (cddr x) (cut defined? <> e2) me)
     766                                            (##sys#canonicalize-body (cddr x) (cut defined? <> e2) me cntr)
    768767                                            e2
    769768                                            me
    … …  
    825824                                          (body
    826825                                           (##sys#compile-to-closure
    827                                             (##sys#canonicalize-body body (cut defined? <> e2) me)
     826                                            (##sys#canonicalize-body body (cut defined? <> e2) me (or h cntr))
    828827                                            e2
    829828                                            me
    … …  
    20372036            (lambda (msg . args)
    20382037              (resetports)
    2039               (##sys#print "Error: " #f ##sys#standard-error)
    2040               (##sys#print msg #f ##sys#standard-error)
     2038              (##sys#print "Error" #f ##sys#standard-error)
     2039              (when msg
     2040                (##sys#print ": " #f ##sys#standard-error)
     2041                (##sys#print msg #f ##sys#standard-error) )
    20412042              (if (and (pair? args) (null? (cdr args)))
    20422043                  (begin

  • chicken/extras.scm

    r1713 r2615  
    15851585
    15861586(define hash-table-update!
    1587   ;; This one was suggested by Sven Hartrumpf.
     1587  ;; This one was suggested by Sven Hartrumpf (and subsequently added in SRFI-69)
    15881588  (let ([eq0 eq?]
    15891589        [floor floor] )
    … …  
    16131613                    (let loop ((bucket bucket0))
    16141614                      (cond ((eq? bucket '())
    1615                              (##sys#setslot vec k (cons (cons key (proc (init))) bucket0))
    1616                              (##sys#setslot ht 2 c) )
     1615                             (let ((val (proc (init))))
     1616                               (##sys#setslot vec k (cons (cons key val) bucket0))
     1617                               (##sys#setslot ht 2 c)
     1618                               val) )
    16171619                            (else
    16181620                             (let ((b (##sys#slot bucket 0)))
    16191621                               (if (eq? key (##sys#slot b 0))
    1620                                    (##sys#setslot b 1 (proc (##sys#slot b 1)))
     1622                                   (let ((val (proc (##sys#slot b 1))))
     1623                                     (##sys#setslot b 1 val)
     1624                                     val)
    16211625                                   (loop (##sys#slot bucket 1)) ) ) ) ) )
    16221626                    (let loop ((bucket bucket0))
    16231627                      (cond ((eq? bucket '())
    1624                              (##sys#setslot vec k (cons (cons key (proc (init))) bucket0))
    1625                              (##sys#setslot ht 2 c) )
     1628                             (let ((val (proc (init))))
     1629                               (##sys#setslot vec k (cons (cons key val) bucket0))
     1630                               (##sys#setslot ht 2 c)
     1631                               val) )
    16261632                            (else
    16271633                             (let ((b (##sys#slot bucket 0)))
    16281634                               (if (test key (##sys#slot b 0))
    1629                                    (##sys#setslot b 1 (proc (##sys#slot b 1)))
     1635                                   (let ((val (proc (##sys#slot b 1))))
     1636                                     (##sys#setslot b 1 val)
     1637                                     val)
    16301638                                   (loop (##sys#slot bucket 1)) ) ) ) ) ) ) ) ) ) ) ) ) )
    16311639

  • chicken/hen.el

    r2119 r2615  
    176176              "fluid-let" "let-values" "let*-values" "letrec-values"
    177177              "parameterize"
    178               "module" "import-only" "import"
     178              "module" "import-only" "import" "import*"
    179179
    180180              "and" "or" "delay" "andmap" "ormap" "receive"

  • chicken/library.scm

    r2536 r2615  
    143143(define (reset) ((##sys#reset-handler)))
    144144
    145 (define (##sys#error msg . args)
    146   (apply ##sys#signal-hook #:error msg args) )
     145(define (##sys#error . args)
     146  (if (pair? args)
     147      (apply ##sys#signal-hook #:error args)
     148      (##sys#signal-hook #:error #f)))
    147149
    148150(define ##sys#warnings-enabled #t)
    … …  
    30453047         (when more1
    30463048           (##sys#with-print-length-limit
    3047             120
     3049            100
    30483050            (lambda ()
    30493051              (##sys#print more1 #t port) ) ) ) ) )
    … …  
    31963198       (##sys#error-handler (lambda args (##core#inline "C_halt" "error in error")))
    31973199       (cond ((##sys#fudge 4)
    3198               (##core#inline "C_display_string" ##sys#standard-error "Error: ")
    3199               (##sys#print msg #f ##sys#standard-error)
     3200              (##core#inline "C_display_string" ##sys#standard-error "Error")
     3201              (when msg
     3202                (##sys#print ": " #f ##sys#standard-error)
     3203                (##sys#print msg #f ##sys#standard-error) )
    32003204              (cond [(fx= 1 (length args))
    32013205                     (##core#inline "C_display_string" ##sys#standard-error ": ")
    … …  
    32163220             (else
    32173221              (let ((out (open-output-string)))
    3218                 (##sys#print msg #f out)
     3222                (when msg (##sys#print msg #f out))
    32193223                (##sys#print #\newline #f out)
    32203224                (##sys#for-each (lambda (x) (##sys#print x #t out) (##sys#print #\newline #f out)) args)
    … …  
    32813285       (when (and (symbol? msg) (null? args))
    32823286         (set! msg (##sys#symbol->string msg)) )
    3283        (let* ([hasloc (or (not msg) (symbol? msg))]
     3287       (let* ([hasloc (and (or (not msg) (symbol? msg)) (pair? args))]
    32843288              [loc (and hasloc msg)]
    32853289              [msg (if hasloc (##sys#slot args 0) msg)]
    … …  
    39773981    (lambda (ex . args)
    39783982      (let-optionals args ([port ##sys#standard-output]
    3979                            [header "Error:"] )
     3983                           [header "Error"] )
    39803984        (##sys#check-port port 'print-error-message)
    39813985        (display header port)
    3982         (##sys#write-char-0 #\space port)
    39833986        (cond [(and (not (##sys#immediate? ex)) (eq? 'condition (##sys#slot ex 0)))
    39843987               (cond ((errmsg ex) =>
    39853988                      (lambda (msg)
     3989                        (display ": " port)
    39863990                        (let ([loc (errloc ex)])
    39873991                          (when (and loc (symbol? loc))
    … …  
    39913995                      (let ((kinds (##sys#slot ex 1)))
    39923996                        (if (equal? '(user-interrupt) kinds)
    3993                             (display "*** user interrupt ***" port)
     3997                            (display ": *** user interrupt ***" port)
    39943998                            (begin
    3995                               (display "<condition> " port)
     3999                              (display ": <condition> " port)
    39964000                              (display (##sys#slot ex 1) port) ) ) ) ) )
    39974001               (and-let* ([args (errargs ex)])
    … …  
    42634267    (##sys#gc #t)
    42644268    #t) )
    4265 

  • chicken/misc/makehtmldoc

    r1984 r2615  
    44|#
    55
    6 ;;; usage: misc/makehtmldoc [PAGE]
     6;;; usage: misc/makehtmldoc [-pdf] [PAGE]
    77
    88(use html-stream stream-ext srfi-40 stream-wiki utils srfi-13 url)
    … …  
    1212(define-constant +index-page+ "The User's Manual")
    1313
     14(define (but-options args)
     15  (filter (lambda (f)
     16            (not (string-prefix? "-" f)))
     17          args))
     18
    1419(define *pages* (directory "wiki"))
    15 (define *only* (:optional (command-line-arguments) #f))
    16            
     20(define *only* (:optional (but-options (command-line-arguments)) #f))
     21(define *generate-pdf* (member "-pdf" (command-line-arguments)))
     22
    1723(define (hyphen s)
    1824  (string-substitute " " "-" s #t) )
    … …  
    4450         (_ (reverse (cons (substring data i) all))) ) ) ) ) )
    4551
     52;; We need this to keep the order of chapters in the PDF file.
     53(define manual-wiki-files
     54  '("The User's Manual"
     55    "Basic mode of operation"
     56    "Using the compiler"
     57    "Using the interpreter"
     58    "Supported language"
     59    "Deviations from the standard"
     60    "Extensions to the standard"
     61    "Non standard read syntax"
     62    "Non standard macros and special forms"
     63    "Pattern matching"
     64    "Declarations"
     65    "Parameters"
     66    "Unit library"
     67    "Unit eval"
     68    "Unit extras"
     69    "Unit srfi-1"
     70    "Unit srfi-4"
     71    "Unit srfi-13"
     72    "Unit srfi-14"
     73    "Unit match"
     74    "Unit regex"
     75    "Unit srfi-18"
     76    "Unit posix"
     77    "Unit utils"
     78    "Unit tcp"
     79    "Unit lolevel"
     80    "Unit tinyclos" ;; not at http://galinha.ucpel.tche.br:8080//Supported%20language anymore
     81    "Interface to external functions and variables"
     82    "Accessing external objects"
     83    "Foreign type specifiers"
     84    "Embedding"
     85    "Callbacks"
     86    "Locations"
     87    "Other support procedures"
     88    "C interface"
     89    "chicken-setup"
     90    "Data representation"
     91    "Bugs and limitations"
     92    "faq"
     93    "Acknowledgements"
     94    "Bibliography"
     95    ))
     96
     97(define (chapters-sanity-check)
     98  "Checks if there all the wiki files listed in `*pages*' are in
     99`manual-wiki-files', just in case we forget to update this
     100variable when new chapters are added; and if all the files listed
     101in `manual-wiki-files' can be found in `*pages*'."
     102  (for-each (lambda (file)
     103              (when (not (member file manual-wiki-files))
     104                (error (conc file " was not found in `manual-wiki-files'."))))
     105            *pages*)
     106  (for-each (lambda (file)
     107              (when (not (member file *pages*))
     108                (error (conc "File \"" file "\" was not found under the wiki directory."))))
     109            manual-wiki-files))
     110 
     111(define (html-files->pdf)
     112  "Requires htmldoc (http://www.htmldoc.org)."
     113  (system (conc "htmldoc --book --numbered --size a4 --title "
     114                "--toctitle \"Chicken User's Manual\" "
     115                " --header t "
     116                "--linkstyle plain --outfile chicken.pdf "
     117                (if *only*
     118                    (html-pagename *only*)
     119                    (string-intersperse
     120                     (map html-pagename manual-wiki-files))))))
     121
     122(define (html-pagename pagename)
     123  (hyphen (string-downcase
     124           (make-pathname
     125            +outpath+
     126            (if (string=? pagename +index-page+) "index" pagename) "html"))))
     127
    46128(define *loaded-extensions* (make-hash-table))
    47129
    … …  
    50132 (glob (conc +extension-path+ "/*")) )
    51133
    52 (for-each
    53  (lambda (p)
    54    (let* ((pagename p)
    55           (po (hyphen (string-downcase
    56                        (make-pathname
    57                         +outpath+
    58                         (if (string=? pagename +index-page+) "index" pagename) "html")))))
    59      (print p " -> " po " ...")
    60      (with-output-to-file po
    61        (lambda ()
    62          (printf "<html><head><title>CHICKEN User's Manual - ~a</title></head><body>~%" pagename)
    63          (write-stream
    64           (wiki->html
    65            (string->stream (convert-page p))
    66            stream-null
    67            ""
    68            (constantly stream-null)
    69            (constantly stream-null)
    70            (make-hash-table)
    71            (make-html-header 1)
    72            (constantly stream-null)
    73            (constantly #t)
    74            *loaded-extensions*) )
    75          (printf "~%</body></html>") ) ) ) )
    76  (if *only* (list *only*) *pages*) )
     134(define (wiki-files->html)
     135  (for-each
     136   (lambda (p)
     137     (let* ((pagename p)
     138            (po (html-pagename pagename)))
     139       (print p " -> " po " ...")
     140       (with-output-to-file po
     141         (lambda ()
     142           (printf "<html><head><title>CHICKEN User's Manual - ~a</title></head><body>~%" pagename)
     143           (write-stream
     144            (wiki->html
     145             (string->stream (convert-page p))
     146             stream-null
     147             ""
     148             (constantly stream-null)
     149             (constantly stream-null)
     150             (make-hash-table)
     151             (make-html-header 1)
     152             (constantly stream-null)
     153             (constantly #t)
     154             *loaded-extensions*) )
     155           (printf "~%</body></html>") ) ) ) )
     156   (if *only* (list *only*) *pages*) ) )
     157
     158
     159;;; Here come the conversions
     160(when *generate-pdf*
     161  (chapters-sanity-check))
     162
     163(wiki-files->html)
     164
     165(when *generate-pdf*
     166  (html-files->pdf))

  • chicken/srfi-4.scm

    r1186 r2615  
    6565#define C_f32poke(b, i, x)     ((((float *)C_data_pointer(b))[ C_unfix(i) ] = C_flonum_magnitude(x)), C_SCHEME_UNDEFINED)
    6666#define C_f64poke(b, i, x)     ((((double *)C_data_pointer(b))[ C_unfix(i) ] = C_flonum_magnitude(x)), C_SCHEME_UNDEFINED)
    67 #define C_copy_subvector(to, from, start_from, bytes)   \
    68   (C_memcpy((C_char *)C_data_pointer(to), (C_char *)C_data_pointer(from) + C_unfix(start_from), C_unfix(bytes)), \
     67#define C_copy_subvector(to, from, start_to, start_from, bytes)   \
     68  (C_memcpy((C_char *)C_data_pointer(to) + C_unfix(start_to), (C_char *)C_data_pointer(from) + C_unfix(start_from), C_unfix(bytes)), \
    6969    C_SCHEME_UNDEFINED)
    7070EOF
    … …  
    591591      (##core#inline "C_string_to_bytevector" bv2)
    592592      (let ([v (##sys#make-structure t bv2)])
    593         (##core#inline "C_copy_subvector" bv2 bv (fx* from es) size2)
     593        (##core#inline "C_copy_subvector" bv2 bv 0 (fx* from es) size2)
    594594        v) ) ) )
    595595
    … …  
    603603(define (subf64vector v from to) (subvector v 'f64vector 8 from to 'subf64vector))
    604604
     605(define (write-u8vector v #!optional (port ##sys#standard-output) (from 0) (to (u8vector-length v)))
     606  (##sys#check-structure v 'u8vector 'write-u8vector)
     607  (##sys#check-port port 'write-u8vector)
     608  (let ((buf (##sys#slot v 1)))
     609    (do ((i from (fx+ i 1)))
     610        ((fx>= i to))
     611      (##sys#write-char-0 (integer->char (##core#inline "C_u8peek" buf i)) port) ) ) )
     612
     613(define (read-u8vector len #!optional (port ##sys#standard-input) v (to 0))
     614  (define (finish p)
     615    (let ((s (get-output-string p)))
     616      (cond (v (let ((n (##sys#size s))
     617                     (bv (##sys#slot v 1)) )
     618                 (##sys#check-range (fx- (fx+ n to) 1) 0 (##sys#size bv) 'read-u8vector)
     619                 (##core#inline "C_copy_subvector" (##sys#slot v 1) s to 0 (##sys#size s))
     620                 v))
     621            (else
     622             (##core#inline "C_string_to_bytevector" s)
     623             (##sys#make-structure 'u8vector s) ) ) ) )
     624  (when v (##sys#check-structure v 'u8vector 'read-u8vector))
     625  (##sys#check-port port 'read-u8vector)
     626  (##sys#check-exact to 'read-u8vector)
     627  (let ((o (open-output-string)))
     628    (when len (##sys#check-exact len 'read-u8vector))
     629    (let loop ((i (or len (and v (fx- (##sys#size (##sys#slot v 1)) to)) -1)))
     630      (if (eq? i 0)
     631          (finish o)
     632          (let ((c (##sys#read-char-0 port)))
     633            (cond ((eof-object? c) (finish o))
     634                  (else
     635                   (##sys#write-char-0 c o)
     636                   (loop (fx- i 1)) ) ) ) ) ) ) )
    605637
    606638(register-feature! 'srfi-4)

  • codewalk/codewalk.scm

    r2488 r2615  
    294294    (when (##sys#symbol-has-toplevel-binding? '##sys#macroexpand-0) ; for backwards compatibility
    295295      (set! ##sys#macroexpand-0 (lambda (x me) x)) )
    296     (set! ##sys#macroexpand-1-local (lambda (x me) x)) ) )
     296    #;(set! ##sys#macroexpand-1-local (lambda (x me) x)) ) )

  • codewalk/codewalk.setup

    r2443 r2615  
    1 (compile -s -O2 -d1 -G codewalk.scm -emit-exports codewalk.exports)
     1(compile -s -O2 -d1 codewalk.scm -emit-exports codewalk.exports)
    22(install-extension
    33 'codewalk

  • dns/dns.setup

    r2447 r2615  
    11
    2 (compile dns.scm -O2 -s -dynamic -G -d0 -explicit-use -no-trace)
     2(compile dns.scm -O2 -s -dynamic -d0 -explicit-use -no-trace)
    33
    44(install-extension 'dns

  • easyffi/easyffi.setup

    r1972 r2615  
    22        (run (csi -s runsilex.scm)) )
    33       ("easyffi.so" ("easyffi.scm" "easyffi.l.scm")
    4         (compile -s -O2 -d0 easyffi.scm -G) ) )
     4        (compile -s -O2 -d0 easyffi.scm) ) )
    55  "easyffi.so")
    66

  • egg-post-commit

    r2543 r2615  
    263263         (print "Creating egg...")
    264264         (if files
    265              (system* "tar cfz ~a -C ~a ~a" (car egg) egg-dir (string-intersperse files))
     265             (system* "cd ~a; tar cfz ../~a ~a" egg-dir (car egg) (string-intersperse files))
    266266             (set! ufile (make-pathname egg-dir (car egg))) )
    267267         (let ((hfile (make-pathname egg-dir eggname "html")))

  • meroon/meroon.setup

    r2496 r2615  
    11;-*- Scheme -*-
    22
    3 (run (csc meroon.scm -vs -O2 -no-trace -lambda-lift -include-path meroon -X meroon.scm -G -emit-exports meroon.exports))
     3(run (csc meroon.scm -vs -O2 -no-trace -lambda-lift -include-path meroon -X meroon.scm -emit-exports meroon.exports))
    44
    55(install-extension

  • modds/modds.setup

    r2570 r2615  
    77
    88(compile
    9  -O2 -d1 -G
     9 -O2 -d1
    1010 -s "modds-base.scm"
    1111 -o ,so-file

  • modules/modules.meta

    r2031 r2615  
    66 (license "BSD")
    77 (doc-from-wiki)
    8  (needs codewalk)
     8 (needs miscmacros codewalk)
    99 (author
    1010   "<a href=\"mailto:felix@call-with-current-continuation.org\">felix</a>")

  • modules/modules.scm

    r1958 r2615  
    99(use miscmacros srfi-1 codewalk)
    1010
    11 (when (memq #:syntax-case ##sys#features)
    12   (error "the `modules' extension is not available in combination with `syntax-case'") )
     11(when (memq #:hygienic-macros ##sys#features)
     12  (error "the `modules' extension is not available in combination with a hygienic macro system") )
    1313
    1414(define-record module
    … …  
    5151                            (set! ,(car imp) ,(cdr imp))) )
    5252                       imps) ) ) ) ) ) )
     53
     54(define-macro (import* mod . is)
     55  (define (filter-imports imps)
     56    (filter-map
     57     (match-lambda
     58       ((new old)
     59        (cons
     60         new
     61         (cond ((assq old imps) => cdr)
     62               (else (syntax-error 'import* "module does not export binding" mod old)) ) ) )
     63       (id (or (assq id imps)
     64               (syntax-error 'import* "module does not export binding" mod old)) ) )
     65     is) )
     66  (let ((c (context))
     67        (imps (resolve-module mod)) )
     68    (cond ((context-current-module c)
     69           (context-current-imports-set!
     70            c
     71            (append
     72             (filter-imports imps)
     73             (context-current-imports c)))
     74           `(##core#undefined))
     75          (else
     76           (let ((tmp (gensym)))
     77             `(let ((,tmp (lambda (sym)
     78                            (warning (sprintf ,(conc "imported toplevel binding `~s' from module `"
     79                                                     mod "' overwrites existing value")
     80                                              sym) ) ) ) )
     81                ,@(map (lambda (imp)
     82                         `(begin
     83                            (if (##sys#symbol-has-toplevel-binding? ',(car imp))
     84                                (,tmp ',(car imp)) )
     85                            (set! ,(car imp) ,(cdr imp))) )
     86                       (filter-imports imps) ) ) ) ) ) ) )
    5387
    5488(define-macro (export-toplevel . args)  ; suggested by Kon Lovett

  • modules/modules.setup

    r2031 r2615  
    44 'modules
    55 '("modules.so" "modules.html")
    6  '((version 0.3)
     6 '((version 0.4)
    77   (syntax)
    88   (documentation "modules.html")))

  • qt/qt.setup

    r2536 r2615  
    99        (run (cp libqtb.so.1.0.0 qt.so)))
    1010       ("qt-base.c" ("qt-base.scm" "prototypes.h")
    11         (run (csc -t qt-base.scm -G -O2 -d1 -X easyffi)) ) )
     11        (run (csc -t qt-base.scm -O2 -d1 -X easyffi)) ) )
    1212  "qt.so")
    1313

  • slib/chicken.init

    r2048 r2615  
    1111;;; Updated for Gambit v3.0, 2001-01 AGJ.
    1212
    13 (use format-modular utils srfi-18)
     13;; Pounded into shape by felix
     14
     15(use format-modular utils srfi-18 records)
    1416
    1517;(define (software-type) 'macos)                ; for MacGambit.
    … …  
    171173                                        ;Programs by Abelson and Sussman.
    172174        defmacro                        ;has Common Lisp DEFMACRO
    173 ;;;     record                          ;has user defined data structures
     175        record                          ;has user defined data structures
    174176;;;     structure                       ;DEFINE-STRUCTURE macro
    175177        string-port                     ;has CALL-WITH-INPUT-STRING and
    … …  
    229231              (set! ports (reverse (cdr ports)))))
    230232  (let ((ans (apply proc ports)))
    231     (for-each close-port ports)         ;FIXME
     233    (for-each close-port ports)         
    232234    ans))
     235
     236(define (close-port p)
     237  ((if (input-port? p) close-input-port close-output-port) p) )
    233238
    234239(define (browse-url url)
    … …  
    330335              `(define-macro (,name ,@parms) ,@body)))
    331336
     337;; to avoid warnings during loading...
     338(define numerator identity)
     339(define denominator identity)
     340(define rationalize identity)
     341(define macro:load load)
     342(define synclo:load load)
     343(define syncase:load load)
     344(define macwork:load load)
     345(define load-ciexyz noop)
     346(define load-color-dictionary noop)
     347(define transcript-on noop)
     348(define transcript-off noop)
     349
    332350(slib:load (in-vicinity (library-vicinity) "require"))

  • slib/slib.meta

    r2048 r2615  
    22 (egg "slib.egg")
    33 (doc-from-wiki)
    4  (needs format-modular)
     4 (needs format-modular records)
    55 (author "Aubrey Jaffer")
    66 (synopsis "Scheme library code")

  • slib/slib.setup

    r2048 r2615  
    1111      csi -qb chicken.init -e "'(require (quote new-catalog))'"))
    1212
    13 (install-extension 'slib '(("chicken.init" "slib.scm")) '((version "3a3") (documentation "slib.html")))
     13(install-extension 'slib '(("chicken.init" "slib.scm")) '((version "3a3.1") (documentation "slib.html")))

  • syntax-case/syntax-case-chicken-macros.scm

    r2460 r2615  
    240240  (lambda (x)
    241241    (syntax-case x ()
    242       [(_ () exp) #'(##sys#call-with-values (lambda () exp) (lambda () (##core#undefined)))]
    243       [(_ (var1 ...) exp)
     242      ((_ () exp) #'(##sys#call-with-values (lambda () exp) (lambda () (##core#undefined))))
     243      ((_ (var) exp) #'(##core#set! var exp))
     244      ((_ (var1 ...) exp)
    244245       (with-syntax ([(tmp1 ...) (generate-temporaries (syntax (var1 ...)))])
    245246         (syntax
    246247          (##sys#call-with-values (lambda () exp)
    247248            (lambda (tmp1 ...)
    248               (##core#set! var1 tmp1) ...) ) ) ) ] ) ) )
     249              (##core#set! var1 tmp1) ...) ) ) ) ) ) ) )
    249250
    250251(define-syntax define-values ; this has been posted by Abdulaziz Ghuloum on c.l.s
    251252  (lambda (ctx)
    252253    (syntax-case ctx ()
    253       [(_ (x* ...) e)
     254      ((_ (x) e) #'(define x e))
     255      ((_ (x* ...) e)
    254256       (with-syntax ([(y* ...) (generate-temporaries #'(x* ...))])
    255257         #'(module (x* ...)
    … …  
    257259               (call-with-values (lambda () e)
    258260                 (lambda (y* ...)
    259                    (set! x* y*) ...))))])))
     261                   (set! x* y*) ...))))))))
    260262
    261263(define-syntax let*-values
    262264  (syntax-rules ()
    263     [(_ () exp1 ...) (let () exp1 ...)]
    264     [(_ (binding0 binding1 ...) exp0 exp1 ...)
     265    ((_ () exp1 ...) (let () exp1 ...))
     266    ((_ (binding0 binding1 ...) exp0 exp1 ...)
    265267     (let-values (binding0)
    266        (let*-values (binding1 ...) exp0 exp1 ...) ) ] ) )
     268       (let*-values (binding1 ...) exp0 exp1 ...) ) ) ) )
    267269
    268270(define-syntax let-values

  • syntax-case/syntax-case.html

    r2460 r2615  
    1616<h3>Version:</h3>
    1717<ul>
     18<li>6.9983
     19Added <code>import*</code>, single-value case handling for <code>set!-values</code> and <code>define-values</code>
    1820<li>6.9982
    1921Improved <code>:optional</code> expansion for unsafe code
    … …  
    185187identifier-syntax
    186188import
     189import*
    187190import-only
    188191let-syntax
    … …  
    203206is allowed for <code>define-syntax</code>.
    204207
    205 <li> When <code>import</code> or <code>import-only</code>
     208<li><code>(import* MODULE IMP ...)</code> allows selective imports. Only the identifiers <code>IMP ...</code>
     209will be imported from <code>MODULE</code>. <code>IMP</code> may be a list of the form <code>(NEW OLD)</code>
     210where the exported identifier <code>OLD</code> will be imported under the name <code>NEW</code>.
     211
     212<li> When <code>import</code>, <code>import*</code> or <code>import-only</code>
    206213is used with an argument that names a module that is currently not defined, then
    207214the current <code>include-path</code> (and the <code>repository-path</code> as well) is searched for a source-file
    … …  
    292299</dl>
    293300
    294 <p>The implementation of <code>cond</code> is <a href="http://srfi.chemers.org/srfi-61/">SRFI-61</a> compliant.
     301<p>The implementation of <code>cond</code> is <a href="http://srfi.schemers.org/srfi-61/">SRFI-61</a> compliant.
    295302
    296303<h3>License:</h3>

  • syntax-case/syntax-case.scm

    r2536 r2615  
    483483      ((_ spec1 ...) (syntax (##core#declare 'spec1 ...))) ) ) )
    484484
     485(define-syntax import*
     486  (syntax-rules ()
     487    ((_ M) (begin))
     488    ((_ M (new old))
     489     ;; The definition from the Dybvig/Waddell paper breaks, unfortunately...
     490     (module (new)
     491         (import M)
     492       (define-syntax new (identifier-syntax old)) ) )
     493    ((_ M id) (module (id) (import M)))
     494    ((_ M s1 s2 ...)
     495     (begin (import* M s1) (import* M s2 ...)))))
     496
    485497)
    486498EOF

  • syntax-case/x.scm

    r1 r2615  
    11(use syntax-case)
    22
    3 #>!
    4 static void ok() { printf("ok\n"); }
    5 <#
    6 
    7 (module foo ()
    8   (ok)
    9   (print "yo!") )
     3($sc-put-cte
     4 'foo
     5 (cons
     6  'core
     7  (lambda (e r w s)
     8    (syntax-case e ()
     9      ((_ x) #'(list 'x))))))

  • tinyclos/tinyclos.setup

    r1375 r2615  
    1 (compile -s -O2 -d1 tinyclos-base.scm -G)
     1(compile -s -O2 -d1 tinyclos-base.scm -emit-exports tinyclos.exports)
    22(install-extension
    33 'tinyclos

  • wiki/Unit extras

    r1703 r2615  
    240240</enscript>
    241241
     242As an extension to SRFI-69, {{hash-table-update!}} and {{hash-table-update!/default}} return
     243the new value (after applying the update procedure).
     244
    242245
    243246=== Queues

  • wiki/Unit library

    r2020 r2615  
    688688==== error
    689689
    690  [procedure] (error [LOCATION] STRING EXP ...)
     690 [procedure] (error [LOCATION] [STRING] EXP ...)
    691691
    692692Prints error message, writes all extra arguments to the

  • wiki/modules

    r2031 r2615  
    66
    77A simple module system for use with the low-level ({{define-macro}}) macro system. Import and export
    8 of macros is not allowed, and importing bindings from other modules may only take place inside a {{module}} form.
     8of macros is not allowed.
    99
    1010In combination with the {{-emit-exports}} compiler option, this module system provides some minimal
    … …  
    3737that are qualified with {{NAME}}. If no such extension can be found, then a file named {{NAME.exports}} will
    3838be searched in the current include-path and qualified identifiers from it will be extracted.
    39 If either an installed extension or an {{.exports}} file doesn't list any qualified export, then
     39If neither an installed extension nor an {{.exports}} file lists any qualified export, then
    4040an error will be signalled.
    4141
    … …  
    4343scope of the module. If used outside of a {{module}} form, then the values of imported bindings will
    4444be assigned to toplevel variables of the same name, overwriting any existing bindings.
     45
     46=== import*
     47
     48 [syntax] (import* NAME IMP ...)
     49
     50Imports selective with optional renaming. Only the identifiers given
     51in {{IMP ...}} will be imported from the module {{NAME}}, where
     52{{IMP}} may be either an identifier or a list of the form {{(NEW OLD)}}.
    4553
    4654=== export-toplevel
    … …  
    9199== Version History
    92100
     101; 0.4 : added {{import*}}
    93102; 0.3 : added codewalk requirement to meta file
    94103; 0.2 : {{import}} is now also allowed outside of {{module}} form

  • wiki/slib

    r2048 r2615  
    5252
    5353
     54== Requirements
     55
     56[[records]], [[format-modular]]
     57
    5458== Version History
    5559
     60; 3a3.1 : uses [[records]] extension
    5661; 3a3 : Initial release as CHICKEN extension
Note: See TracChangeset for help on using the changeset viewer.