Changeset 15229 in project for chicken


Ignore:
Timestamp:
07/17/09 15:36:10 (10 years ago)
Author:
felix winkelmann
Message:

(really) merged trunk changes till 15228 into prerelease branch

Location:
chicken/branches/prerelease
Files:
34 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/prerelease

    • Property svn:mergeinfo deleted
  • chicken/branches/prerelease/NEWS

    r15167 r15229  
    99- Added command-line option "-r5rs-syntax" to disable CHICKEN-specific
    1010  read-syntax
     11- Added compiler command-line-option "-no-compiler-syntax"
     12- Deprecated "getenv" (use "get-environment-variable" instead)
    1113- Removed "macro?" and "undefine-macro!"
    1214- Support for Microsoft Visual Studio / MSVC has been dropped
     
    2527  added "socket?", "block-device?" and "character-device?", deprecated
    2628  redundant "stat-..." procedures
     29- Also in Posix unit: "canonical-path" has been deprecated, "normalize-pathname"
     30  from the "files" unit provides now most of the functionality
    2731- Added "directory-exists?"
    2832- "(for-each (lambda ...) X)" is compiled as a loop
  • chicken/branches/prerelease/batch-driver.scm

    r15101 r15229  
    5353  reorganize-recursive-bindings substitution-table simplify-named-call emit-unsafe-marker
    5454  perform-closure-conversion prepare-for-code-generation compiler-source-file create-foreign-stub expand-foreign-lambda*
    55   transform-direct-lambdas! source-filename standalone-executable
     55  transform-direct-lambdas! source-filename standalone-executable compiler-syntax-enabled
    5656  debugging-chicken bomb check-signature posq stringify symbolify build-lambda-list
    5757  string->c-identifier c-ify-string words check-and-open-input-file close-checked-input-file fold-inner constant?
     
    114114                       [(memq 'to-stdout options) #f]
    115115                       [else (make-pathname #f (if filename (pathname-file filename) "out") "c")] ) ]
    116         [ipath (map chop-separator (string-split (or (getenv "CHICKEN_INCLUDE_PATH") "") ";"))]
     116        [ipath (map chop-separator (string-split (or (get-environment-variable "CHICKEN_INCLUDE_PATH") "") ";"))]
    117117        [opasses default-optimization-passes]
    118118        [time0 #f]
     
    241241    (when (memq 'no-lambda-info options)
    242242      (set! emit-closure-info #f) )
     243    (when (memq 'no-compiler-syntax options)
     244      (set! compiler-syntax-enabled #f))
    243245    (when (memq 'local options)
    244246      (set! local-definitions #t))
     
    526528
    527529               (print-node "initial node tree" '|T| node0)
     530               (initialize-analysis-database)
    528531
    529532               (when do-scrutinize
  • chicken/branches/prerelease/c-platform.scm

    r15101 r15229  
    125125    emit-external-prototypes-first release local inline-global
    126126    analyze-only dynamic scrutinize no-argc-checks no-procedure-checks
    127     no-bound-checks no-procedure-checks-for-usual-bindings
     127    no-bound-checks no-procedure-checks-for-usual-bindings no-compiler-syntax
    128128    no-parentheses-synonyms no-symbol-escape r5rs-syntax) )
    129129
     
    179179    u8vector-set! s8vector-set! u16vector-set! s16vector-set! u32vector-set! s32vector-set!
    180180    locative-ref locative-set! locative->object locative? global-ref
    181     null-pointer? pointer->object flonum? finite?) )
     181    null-pointer? pointer->object flonum? finite?
     182    printf sprintf format) )
    182183
    183184(define internal-bindings
  • chicken/branches/prerelease/chicken-ffi-syntax.scm

    r13240 r15229  
    138138 (##sys#er-transformer
    139139  (lambda (form r c)
    140     (##sys#check-syntax 'foreign-value form '(_ string _))
    141     (let ([tmp (gensym 'code_)])
     140    (##sys#check-syntax 'foreign-value form '(_ _ _))
     141    (let ((tmp (gensym 'code_))
     142          (code (cadr form)))
    142143      `(,(r 'begin)
    143         (,(r 'define-foreign-variable) ,tmp ,(caddr form) ,(cadr form))
     144        (,(r 'define-foreign-variable) ,tmp
     145         ,(caddr form)
     146         ,(cond ((string? code) code)
     147                ((symbol? code) (symbol->string code))
     148                (else (syntax-error 'foreign-value "bad argument type - not a string or symbol" code))))
    144149        ,tmp) ) ) ) )
    145150
  • chicken/branches/prerelease/chicken-install.scm

    r15101 r15229  
    4141  (define +default-repository-files+
    4242    '("setup-api.so" "setup-api.import.so"
    43       "setup-utils.so" "setup-utils.import.so"
    4443      "setup-download.so" "setup-download.import.so"
    4544      "chicken.import.so"
     
    6665
    6766  (define *program-path*
    68     (or (and-let* ((p (getenv "CHICKEN_PREFIX")))
     67    (or (and-let* ((p (get-environment-variable "CHICKEN_PREFIX")))
    6968          (make-pathname p "bin") )
    7069        (foreign-value "C_INSTALL_BIN_HOME" c-string) ) )
  • chicken/branches/prerelease/chicken.import.scm

    r15101 r15229  
    132132   get-output-string
    133133   get-properties
    134    getenv
     134   getenv                               ; DEPRECATED
    135135   getter-with-setter
    136136   implicit-exit-handler
  • chicken/branches/prerelease/chicken.scm

    r14954 r15229  
    7878   (remove
    7979    (lambda (x) (string=? x ""))
    80     (string-split (or (getenv "CHICKEN_OPTIONS") "")))
     80    (string-split (or (get-environment-variable "CHICKEN_OPTIONS") "")))
    8181   (cdr (argv))))
    8282
  • chicken/branches/prerelease/compiler.scm

    r15122 r15229  
    293293  pprint-expressions-to-file foreign-type-check estimate-foreign-result-size scan-used-variables scan-free-variables
    294294  topological-sort print-version print-usage initialize-analysis-database csc-control-file
    295   estimate-foreign-result-location-size inline-output-file
     295  estimate-foreign-result-location-size inline-output-file compiler-syntax-enabled
    296296  expand-foreign-callback-lambda default-optimization-passes default-optimization-passes-when-trying-harder
    297297  units-used-by-default words-per-flonum disable-stack-overflow-checking
     
    382382(define do-scrutinize #f)
    383383(define enable-inline-files #f)
     384(define compiler-syntax-enabled #t)
    384385
    385386
     
    550551             (let* ((name0 (lookup (car x) se))
    551552                    (name (or (and (symbol? name0) (##sys#get name0 '##core#primitive)) name0))
    552                     (xexpanded (##sys#expand x se #t)))
     553                    (xexpanded (##sys#expand x se compiler-syntax-enabled)))
    553554               (cond ((not (eq? x xexpanded))
    554555                      (walk xexpanded e se dest))
     
    641642                                     (list alias (walk (cadr b) e se (car b))) )
    642643                                   aliases bindings)
    643                              ,(walk (##sys#canonicalize-body (cddr x) se2 #t)
     644                             ,(walk (##sys#canonicalize-body (cddr x) se2 compiler-syntax-enabled)
    644645                                    (append aliases e)
    645646                                    se2 dest) ) ) )
     
    674675                              (let* ((aliases (map gensym vars))
    675676                                     (se2 (append (map cons vars aliases) se))
    676                                      (body0 (##sys#canonicalize-body obody se2 #t))
     677                                     (body0 (##sys#canonicalize-body obody se2 compiler-syntax-enabled))
    677678                                     (body (walk body0 (append aliases e) se2 #f))
    678679                                     (llist2
     
    718719                                     se) ) )
    719720                           (walk
    720                             (##sys#canonicalize-body (cddr x) se2 #t)
     721                            (##sys#canonicalize-body (cddr x) se2 compiler-syntax-enabled)
    721722                            e se2
    722723                            dest) ) )
     
    737738                           ms)
    738739                          (walk
    739                            (##sys#canonicalize-body (cddr x) se2 #t)
     740                           (##sys#canonicalize-body (cddr x) se2 compiler-syntax-enabled)
    740741                           e se2 dest)))
    741742                               
     
    803804                              (lambda ()
    804805                                (walk
    805                                  (##sys#canonicalize-body (cddr x) se #t)
     806                                 (##sys#canonicalize-body (cddr x) se compiler-syntax-enabled)
    806807                                 e se dest) )
    807808                              (lambda ()
     
    908909                               [body
    909910                                (walk
    910                                  (##sys#canonicalize-body obody se2 #t)
     911                                 (##sys#canonicalize-body obody se2 compiler-syntax-enabled)
    911912                                 (append aliases e)
    912913                                 se2 #f) ] )
     
    19131914                 (any (lambda (id2) (contains? id2 other-ids)) clist) ) ) ) )
    19141915
    1915     ;; Initialize database:
    1916     (initialize-analysis-database db)
    1917 
    19181916    ;; Walk toplevel expression-node:
    19191917    (debugging 'p "analysis traversal phase...")
  • chicken/branches/prerelease/csc.scm

    r15101 r15229  
    6969  (exit 64) )
    7070
    71 (define chicken-prefix (getenv "CHICKEN_PREFIX"))
     71(define chicken-prefix (get-environment-variable "CHICKEN_PREFIX"))
    7272(define arguments (command-line-arguments))
    7373(define host-mode (member "-host" arguments))
     
    130130    -analyze-only -keep-shadowed-macros -inline-global -ignore-repository
    131131    -no-symbol-escape -no-parentheses-synonyms -r5rs-syntax
    132     -no-argc-checks -no-bound-checks -no-procedure-checks
     132    -no-argc-checks -no-bound-checks -no-procedure-checks -no-compiler-syntax
    133133    -no-procedure-checks-for-usual-bindings))
    134134
     
    315315    -j -emit-import-library MODULE write compile-time module information into
    316316                                    separate file
     317    -no-compiler-syntax            disable expansion of compiler-macros
    317318
    318319  Translation options:
     
    936937;;; Run it:
    937938
    938 (run (append (string-split (or (getenv "CSC_OPTIONS") "")) arguments))
     939(run (append (string-split (or (get-environment-variable "CSC_OPTIONS") "")) arguments))
  • chicken/branches/prerelease/csi.scm

    r15101 r15229  
    190190                (else (loop (fx+ i 1))) ) ) ) )
    191191    (lambda (name)
    192       (let ([path (getenv "PATH")])
     192      (let ([path (get-environment-variable "PATH")])
    193193        (and (> (##sys#size name) 0)
    194194             (cond [(dirseparator? (string-ref name 0)) (addext name)]
     
    873873
    874874(define (run)
    875   (let* ([extraopts (parse-option-string (or (getenv "CSI_OPTIONS") ""))]
     875  (let* ([extraopts (parse-option-string (or (get-environment-variable "CSI_OPTIONS") ""))]
    876876         [args (canonicalize-args (command-line-arguments))]
    877877         ; Check for these before 'args' is updated by any 'extraopts'
     
    898898           [quietflag (member* '("-q" "-quiet") args)]
    899899           [quiet (or script quietflag eval?)]
    900            [ipath (map chop-separator (string-split (or (getenv "CHICKEN_INCLUDE_PATH") "") ";"))] )     
     900           [ipath (map chop-separator (string-split (or (get-environment-variable "CHICKEN_INCLUDE_PATH") "") ";"))] )     
    901901      (define (collect-options opt)
    902902        (let loop ([opts args])
     
    911911          (if (file-exists? fn)
    912912              (load fn)
    913               (let* ([prefix (chop-separator (or (getenv "HOME") "."))]
     913              (let* ([prefix (chop-separator (or (get-environment-variable "HOME") "."))]
    914914                     [fn (string-append prefix "/" init-file)] )
    915915                (when (file-exists? fn)
  • chicken/branches/prerelease/eval.scm

    r15228 r15229  
    7474     ##sys#repl-eval-hook ##sys#append ##sys#eval-decorator
    7575     open-output-string get-output-string make-parameter software-type software-version machine-type
    76      build-platform getenv set-extensions-specifier! ##sys#string->symbol list->vector
     76     build-platform set-extensions-specifier! ##sys#string->symbol list->vector get-environment-variable
    7777     extension-information syntax-error ->string chicken-home ##sys#expand-curried-define
    7878     vector->list store-string open-input-string eval ##sys#gc
     
    127127
    128128(define ##sys#chicken-prefix
    129   (let ((prefix (and-let* ((p (getenv prefix-environment-variable)))
     129  (let ((prefix (and-let* ((p (get-environment-variable prefix-environment-variable)))
    130130                  (##sys#string-append
    131131                   p
     
    712712                                   (let-values ([(exp _)
    713713                                                 (##sys#do-the-right-thing (car ids) #f imp?)])
    714                                      `(,(rename 'begin se) ,exp ,(loop (cdr ids))) ) ) )
     714                                     `(##core#begin ,exp ,(loop (cdr ids))) ) ) )
    715715                             e #f tf cntr se) ) ]
    716716
     
    10871087(define ##sys#repository-path
    10881088  (make-parameter
    1089    (or (getenv repository-environment-variable)
     1089   (or (get-environment-variable repository-environment-variable)
    10901090       (##sys#chicken-prefix
    10911091        (##sys#string-append
     
    16411641                                     (##sys#write-char-0 #\) ##sys#standard-error) )
    16421642                                   (##sys#write-char-0 #\newline ##sys#standard-error) )
    1643                                  u) ) )
     1643                                 u)
     1644                                (##sys#flush-output ##sys#standard-error)))
    16441645                             ((or (memq (caar vars) u)
    16451646                                  (##sys#symbol-has-toplevel-binding? (caar vars)) )
  • chicken/branches/prerelease/expand.scm

    r15101 r15229  
    485485                          (err "`#!key' argument marker in wrong context") ) ]
    486486                     [else
    487                       (cond [(symbol? x)
     487                      (cond [(symbol? var)
    488488                             (case mode
    489                                [(0) (loop 0 (cons x req) '() '() r)]
    490                                [(1) (loop 1 req (cons (list x #f) opt) '() r)]
     489                               [(0) (loop 0 (cons var req) '() '() r)]
     490                               [(1) (loop 1 req (cons (list var #f) opt) '() r)]
    491491                               [(2) (err "invalid lambda list syntax after `#!rest' marker")]
    492                                [else (loop 3 req opt (cons (list x) key) r)] ) ]
    493                             [(and (list? x) (eq? 2 (length x)))
     492                               [else (loop 3 req opt (cons (list var) key) r)] ) ]
     493                            [(and (list? var) (eq? 2 (length var)))
    494494                             (case mode
    495495                               [(0) (err "invalid required argument syntax")]
    496                                [(1) (loop 1 req (cons x opt) '() r)]
     496                               [(1) (loop 1 req (cons var opt) '() r)]
    497497                               [(2) (err "invalid lambda list syntax after `#!rest' marker")]
    498                                [else (loop 3 req opt (cons x key) r)] ) ]
     498                               [else (loop 3 req opt (cons var key) r)] ) ]
    499499                            [else (err "invalid lambda list syntax")] ) ] ) ) ] ) ) ) ) ) )
    500500
  • chicken/branches/prerelease/files.scm

    r15228 r15229  
    5252      string-match regexp
    5353      ##sys#string-append ##sys#substring  string-append
    54       getenv
     54      get-environment-variable
    5555      file-exists? delete-file
    5656      call-with-output-file read-string)
     
    325325
    326326(define create-temporary-file
    327   (let ([getenv getenv]
     327  (let ([get-environment-variable get-environment-variable]
    328328        [make-pathname make-pathname]
    329329        [file-exists? file-exists?]
     
    346346;;; normalize pathname for a particular platform
    347347
    348 (define (normalize-pathname path #!optional (platform (build-platform)))
    349   (case platform
    350     ((mingw32 msvc)
    351      (string-translate path "/" "\\"))
    352     (else path)))
     348(define normalize-pathname
     349  (let ((open-output-string open-output-string)
     350        (get-output-string get-output-string)
     351        (get-environment-variable get-environment-variable)
     352        (reverse reverse)
     353        (display display))
     354    (lambda (path #!optional (platform (if (memq (build-platform) '(msvc mingw32)) 'windows 'unix)))
     355      (let ((sep (if (eq? platform 'windows) #\\ #\/)))
     356        (define (addpart part parts)
     357          (cond ((string=? "." part) parts)
     358                ((string=? ".." part)
     359                 (if (null? parts)
     360                     '("..")
     361                     (cdr parts)))
     362                (else (cons part parts))))
     363        (##sys#check-string path 'normalize-pathname)
     364        (let ((len (##sys#size path))
     365              (abspath #f)
     366              (drive #f))
     367          (let loop ((i 0) (prev 0) (parts '()))
     368            (cond ((fx>= i len)
     369                   (when (fx> i prev)
     370                     (set! parts (addpart (##sys#substring path prev i) parts)))
     371                   (if (null? parts)
     372                       (##sys#string-append "." (string sep))
     373                       (let ((out (open-output-string))
     374                             (parts (reverse parts)))
     375                         (display (car parts) out)
     376                         (for-each
     377                          (lambda (p)
     378                            (##sys#write-char-0 sep out)
     379                            (display p out) )
     380                          (cdr parts))
     381                         (when (fx= i prev) (##sys#write-char-0 sep out))
     382                         (let* ((r1 (get-output-string out))
     383                                (r (##sys#expand-home-path r1)))
     384                           (when (string=? r1 r)
     385                             (when abspath
     386                               (set! r (##sys#string-append (string sep) r)))
     387                             (when drive
     388                               (set! r (##sys#string-append drive r))))
     389                           r))))
     390                  ((memq (string-ref path i) '(#\\ #\/))
     391                   (when (and (null? parts) (fx= i prev))
     392                     (set! abspath #t))
     393                   (if (fx= i prev)
     394                       (loop (fx+ i 1) (fx+ i 1) parts)
     395                       (loop (fx+ i 1)
     396                             (fx+ i 1)
     397                             (addpart (##sys#substring path prev i) parts))))
     398                  ((and (null? parts)
     399                        (char=? (string-ref path i) #\:)
     400                        (eq? 'windows platform))
     401                   (set! drive (##sys#substring path 0 (fx+ i 1)))
     402                   (loop (fx+ i 1) (fx+ i 1) '()))
     403                  (else (loop (fx+ i 1) prev parts)))))))))
    353404
    354405
  • chicken/branches/prerelease/library.scm

    r15101 r15229  
    159159     ##sys#pointer->address number->string ##sys#flush-output ##sys#break-entry ##sys#step
    160160     ##sys#apply-values ##sys#get-call-chain ##sys#really-print-call-chain
    161      string->keyword keyword? string->keyword getenv ##sys#number->string ##sys#copy-bytes
     161     string->keyword keyword? string->keyword get-environment-variable ##sys#number->string ##sys#copy-bytes
    162162     call-with-current-continuation ##sys#string->number ##sys#inexact->exact ##sys#exact->inexact
    163163     ##sys#reverse-list->string reverse ##sys#inexact? list? string ##sys#char->utf8-string
     
    232232(define ##sys#decode-seconds (##core#primitive "C_decode_seconds"))
    233233(define get-environment-variable (##core#primitive "C_get_environment_variable"))
    234 (define getenv get-environment-variable)
     234(define getenv get-environment-variable) ; DEPRECATED
    235235(define (##sys#start-timer) (##core#inline "C_start_timer"))
    236236(define ##sys#stop-timer (##core#primitive "C_stop_timer"))
     
    18461846
    18471847(define ##sys#expand-home-path
    1848   (let ((getenv getenv))
     1848  (let ((get-environment-variable get-environment-variable))
    18491849    (lambda (path)
    18501850      (let ((len (##sys#size path)))
     
    18531853              ((#\~)
    18541854               (let ((rest (##sys#substring path 1 len)))
    1855                  (if (and (fx> len 1) (char=? #\/ (##core#inline "C_subchar" path 1)))
    1856                      (##sys#string-append (or (getenv "HOME") "") rest)
    1857                      (##sys#string-append "/home/" rest) ) ) )
     1855                 (##sys#string-append (or (get-environment-variable "HOME") "") rest) ) )
    18581856              ((#\$)
    18591857               (let loop ((i 1))
     
    18631861                       (if (or (eq? c #\/) (eq? c #\\))
    18641862                           (##sys#string-append
    1865                             (or (getenv (##sys#substring path 1 i)) "")
     1863                            (or (get-environment-variable (##sys#substring path 1 i)) "")
    18661864                            (##sys#substring path i len))
    18671865                           (loop (fx+ i 1)) ) ) ) ) )
  • chicken/branches/prerelease/lolevel.scm

    r13859 r15229  
    365365(define pointer-s8-ref
    366366  (getter-with-setter
    367    (foreign-lambda* int ([c-pointer p]) "return(*((char *)p));")
     367   (foreign-lambda* int ([c-pointer p]) "return(*((signed char *)p));")
    368368   pointer-s8-set!) )
    369369
  • chicken/branches/prerelease/manual/Accessing external objects

    r13859 r15229  
    2121=== foreign-value
    2222
    23  [syntax] (foreign-value STRING TYPE)
     23 [syntax] (foreign-value CODE TYPE)
    2424
    25 Evaluates the embedded C/C++ expression {{STRING}}, returning a value of type given
     25Evaluates the embedded C/C++ expression {{CODE}} (which may be a string or symbol), returning a value of type given
    2626in the foreign-type specifier {{TYPE}}.
    2727
  • chicken/branches/prerelease/manual/The User's Manual

    r15228 r15229  
    77</nowiki>
    88
    9 This is the user's manual for the Chicken Scheme compiler, version 4.1.0rc2
     9This is the manual for Chicken Scheme, version 4.1.0rc2
    1010
    1111; [[Getting started]] : What is CHICKEN and how do I use it?
  • chicken/branches/prerelease/manual/Unit files

    r15101 r15229  
    8787
    8888Performs a simple "normalization" on the {{PATHNAME}}, suitably for
    89 {{PLATFORM}}, which defaults to the value of {{(build-platform)}}.
    90 Currently, this just converts forward slashes to backslashes on Windows.
     89{{PLATFORM}}, which should be one of the symbols {{windows}}
     90or {{unix}} and defaults to on whatever platform is currently
     91in use. All relative path elements and duplicate separators are processed
     92and removed.  If {{NAME}} ends with
     93a {{/}} or is empty, the appropriate slash is appended to the tail.
     94Tilde {{~}} and variable {{$<name>/...}} expansion is also done.
     95
     96No directories or files are actually tested for existence; this
     97procedure only canonicalises path syntax.
    9198
    9299==== directory-null?
  • chicken/branches/prerelease/manual/Unit posix

    r15101 r15229  
    123123file-patterns (with {{*}} matching zero or more characters and
    124124{{?}} matching zero or one character).
    125 
    126 ==== canonical-path
    127 
    128 <procedure>(canonical-path NAME)</procedure>
    129 
    130 Returns a canonical path for {{NAME}}, which should be a string
    131 containing a path-or-filename.  The string returned by
    132 {{canonical-path}} is OS dependent; it may be quoted and used in
    133 a shell on the calling machine. (Quoting is suggested as shell
    134 special characters, including space, are not escaped.)  However,
    135 all path separators and prefixes are handled in an OS independent
    136 fashion.  Any appearance of {{/}} below imply {{\\}} is also handled.
    137 
    138 The prefix for {{NAME}} determines what path to prepend.  If {{NAME}}
    139 begins with a {{"~/"}}, this prefix is stripped and the user's
    140 home directory is added.  If beginning with {{/}} or a DRIVE-LETTER:\\
    141 combination, no additional path is added.  Otherwise, the current
    142 directory and separator are added.  All relative path elements and
    143 duplicate separators are processed and removed.  If {{NAME}} ends with
    144 a {{/}} or is empty, the appropriate slash is appended to the tail.
    145 
    146 No directories or files are actually tested for existence; this
    147 procedure only canonicalises path syntax.
    148125
    149126==== set-root-directory!
  • chicken/branches/prerelease/manual/faq

    r15101 r15229  
    415415{{boolean?}} {{number?}} {{complex?}} {{rational?}} {{real?}} {{exact?}} {{inexact?}} {{list?}} {{eof-object?}}
    416416{{string-ref}} {{string-set!}} {{vector-ref}} {{vector-set!}} {{char=?}} {{char<?}} {{char>?}} {{char<=?}} {{char>=?}}
    417 {{char-numeric?}} {{char-alphabetic?}} {{char-whitespace?}} {{char-upper-case?}}
     417{{char-numeric?}} {{char-alphabetic?}} {{char-whitespace?}} {{char-upper-case?}} {{for-each}}
    418418{{char-lower-case?}} {{char-upcae}} {{char-downcase}} {{list-tail}} {{assv}} {{memv}} {{memq}} {{assoc}}
    419419{{member}} {{set-car!}} {{set-cdr!}} {{abs}} {{exp}} {{sin}} {{cos}} {{tan}} {{log}} {{asin}} {{acos}} {{atan}} {{sqrt}}
     
    471471{{cpu-time}} {{error}} {{call/cc}} {{any?}}
    472472{{substring=?}} {{substring-ci=?}} {{substring-index}} {{substring-index-ci}}
     473{{printf}} {{sprintf}} {{fprintf}} {{format}}
    473474
    474475==== What's the difference betweem "block" and "local" mode?
  • chicken/branches/prerelease/optimizer.scm

    r15101 r15229  
    18311831         (%begin (r 'begin))
    18321832         (%pair? (r 'pair?)))
    1833      (if (= 3 (length x))
     1833     (if (and (memq 'for-each standard-bindings) ; we have to check this because the db (and thus
     1834              (= 3 (length x)))                  ; intrinsic marks) isn't set up yet
    18341835         `(,%let ,%loop ((,%lst ,(caddr x)))
    18351836                 (,%if (,%pair? ,%lst)
     
    18911892   (lambda (return)
    18921893     (and (>= (length args) 1)
     1894          (memq func extended-bindings) ; s.a.
    18931895          (or (string? (car args))
    18941896              (and (list? (car args))
  • chicken/branches/prerelease/posix.import.scm

    r15101 r15229  
    3030   call-with-input-pipe
    3131   call-with-output-pipe
    32    canonical-path
     32   canonical-path                       ; DEPRECATED
    3333   change-directory
    3434   change-file-mode
  • chicken/branches/prerelease/posixunix.scm

    r15101 r15229  
    487487     ##sys#make-port ##sys#file-info ##sys#update-errno ##sys#fudge ##sys#make-c-string ##sys#check-port
    488488     ##sys#error ##sys#signal-hook ##sys#peek-unsigned-integer make-pathname glob directory?
    489      pathname-file process-fork file-close duplicate-fileno process-execute getenv
     489     pathname-file process-fork file-close duplicate-fileno process-execute get-environment-variable
    490490     make-string make-input-port make-output-port ##sys#thread-block-for-i/o create-pipe
    491491     process-wait pathname-strip-directory ##sys#expand-home-path directory
     
    890890    (##sys#check-string name 'create-directory)
    891891    (if parents?
    892         (create-directory-helper-parents (canonical-path name))
    893         (create-directory-helper (canonical-path name)))))
    894 ;    (unless (zero? (##core#inline "C_mkdir" (##sys#make-c-string (##sys#expand-home-path name))))
    895 ;      (posix-error #:file-error 'create-directory "cannot create directory" name) ) ) )
     892        (create-directory-helper-parents name)
     893        (create-directory-helper name))))
    896894
    897895(define change-directory
     
    952950                (posix-error #:file-error 'current-directory "cannot retrieve current directory") ) ) ) ) ) )
    953951
    954 
    955 (define canonical-path
     952(define canonical-path                  ; DEPRECATED
    956953    (let ((null?      null?)
    957954          (char=?     char=?)
     
    963960          (isperse    (cut string-intersperse <> "/"))
    964961          (sep?       (lambda (c) (or (char=? #\/ c) (char=? #\\ c))))
    965           (getenv     getenv)
     962          (get-environment-variable     get-environment-variable)
    966963          (user       current-user-name)
    967964          (cwd        (let ((cw   current-directory))
     
    981978                                   (sep? (sref path 1)))
    982979                                 (sappend
    983                                      (or (getenv "HOME")
     980                                     (or (get-environment-variable "HOME")
    984981                                         (sappend "/home/" (user)))
    985982                                     (##sys#substring path 1
     
    22052202
    22062203(define (##sys#shell-command)
    2207   (or (getenv "SHELL") "/bin/sh") )
     2204  (or (get-environment-variable "SHELL") "/bin/sh") )
    22082205
    22092206(define (##sys#shell-command-arguments cmdlin)
  • chicken/branches/prerelease/posixwin.scm

    r15101 r15229  
    18871887
    18881888(define (##sys#shell-command)
    1889   (or (getenv "COMSPEC")
     1889  (or (get-environment-variable "COMSPEC")
    18901890      (if (##core#inline "C_get_shlcmd")
    18911891          _shlcmd
     
    18991899(define process-run
    19001900  (let ([process-spawn process-spawn]
    1901         [getenv getenv] )
     1901        [get-environment-variable get-environment-variable] )
    19021902    (lambda (f . args)
    19031903      (let ([args (if (pair? args) (car args) #f)])
  • chicken/branches/prerelease/rules.make

    r15101 r15229  
    12111211# cleaning up
    12121212
    1213 .PHONY: clean distclean spotless confclean
     1213.PHONY: clean distclean spotless confclean testclean
    12141214
    12151215ifeq ($(PLATFORM),mingw)
     
    12271227          libchicken$(A) libuchicken$(A) libchickengui$(A) libchicken$(SO) $(PROGRAM_IMPORT_LIBRARIES) \
    12281228          $(IMPORT_LIBRARIES:=.import.so) $(LIBCHICKEN_IMPORT_LIBRARY) $(LIBUCHICKEN_IMPORT_LIBRARY) \
    1229           $(LIBCHICKENGUI_IMPORT_LIBRARY) \
     1229          $(LIBCHICKENGUI_IMPORT_LIBRARY) setup-api.so setup-download.so setup-api.c setup-download.c \
    12301230          $(CLEAN_MINGW_LIBS)
    12311231
     
    12331233        -$(REMOVE_COMMAND) $(REMOVE_COMMAND_OPTIONS) chicken-config.h chicken-defaults.h buildsvnrevision
    12341234
    1235 spotless: distclean
     1235spotless: distclean testclean
    12361236        -$(REMOVE_COMMAND) $(REMOVE_COMMAND_OPTIONS) library.c eval.c data-structures.c \
    12371237          ports.c files.c extras.c lolevel.c utils.c chicken-syntax.c \
     
    12431243          csc.c csi.c chicken-install.c chicken-setup.c chicken-uninstall.c chicken-status.c \
    12441244          chicken.c batch-driver.c compiler.c optimizer.c scrutinizer.c support.c \
    1245           c-platform.c c-backend.c \
     1245          c-platform.c c-backend.c chicken-boot$(EXE) \
    12461246          $(IMPORT_LIBRARIES:=.import.c)
    12471247
    12481248distclean: clean confclean
     1249
     1250testclean:
     1251        $(REMOVE_COMMAND) $(REMOVE_COMMAND_OPTIONS) $(SRCDIR)tests/*.out $(SRCDIR)tests/tmp* \
     1252          $(SRCDIR)tests/*.so $(SRCDIR)tests/*.import.scm $(SRCDIR)tests/repository
    12491253
    12501254# run tests
  • chicken/branches/prerelease/scripts/henrietta.scm

    r14954 r15229  
    144144                   (loop rest))
    145145                  ((string=? ms "list")
     146                   (headers)
    146147                   (listing))
    147148                  (else
  • chicken/branches/prerelease/setup-api.scm

    r15101 r15229  
    9191
    9292(define *chicken-bin-path*
    93   (or (and-let* ((p (getenv "CHICKEN_PREFIX")))
     93  (or (and-let* ((p (get-environment-variable "CHICKEN_PREFIX")))
    9494        (make-pathname p "bin") )
    9595      (foreign-value "C_INSTALL_BIN_HOME" c-string) ) )
    9696
    9797(define *doc-path*
    98   (or (and-let* ((p (getenv "CHICKEN_PREFIX")))
     98  (or (and-let* ((p (get-environment-variable "CHICKEN_PREFIX")))
    9999        (make-pathname p "share/chicken/doc") )
    100100      (make-pathname
     
    103103
    104104(define chicken-prefix
    105   (or (getenv "CHICKEN_PREFIX")
     105  (or (get-environment-variable "CHICKEN_PREFIX")
    106106      (let ((m (string-match "(.*)/bin/?" *chicken-bin-path*)))
    107107        (if m
     
    436436
    437437(define installation-prefix
    438   (make-parameter (or (getenv "CHICKEN_INSTALL_PREFIX") #f)))
     438  (make-parameter (or (get-environment-variable "CHICKEN_INSTALL_PREFIX") #f)))
    439439
    440440(define (write-info id files info)
     
    731731
    732732(define (create-temporary-directory)
    733   (let ((dir (or (getenv "TMPDIR") (getenv "TEMP") (getenv "TMP") "/tmp")))
     733  (let ((dir (or (get-environment-variable "TMPDIR")
     734                 (get-environment-variable "TEMP")
     735                 (get-environment-variable "TMP")
     736                 "/tmp")))
    734737    (let loop ()
    735738      (let* ((n (##sys#fudge 16))       ; current milliseconds
  • chicken/branches/prerelease/setup-download.scm

    r14954 r15229  
    111111
    112112  (define (make-svn-ls-cmd uarg parg pnam #!key recursive?)
    113     (conc "svn ls " uarg #\space parg (if recursive? " -R " "") (qs pnam)) )
     113    (conc "svn ls " uarg #\space parg (if recursive? " -R " " ") (qs pnam)) )
    114114
    115115  (define (make-svn-export-cmd uarg parg dir tmpdir)
  • chicken/branches/prerelease/support.scm

    r14954 r15229  
    338338(define initialize-analysis-database
    339339  (let ((initial #t))
    340     (lambda (db)
     340    (lambda ()
    341341      (when initial
    342342        (for-each
    343          (lambda (s) 
     343         (lambda (s)
    344344           (mark-variable s '##compiler#intrinsic 'standard)
    345345           (when (memq s foldable-bindings)
     
    12701270    -emit-import-library MODULE  write compile-time module information into
    12711271                                  separate file
     1272    -no-compiler-syntax          disable expansion of compiler-macros
    12721273
    12731274  Translation options:
  • chicken/branches/prerelease/tests/module-tests.scm

    r13240 r15229  
    146146            1)
    147147
     148(module m14 (test-extlambda)
     149  (import chicken scheme)
     150  (define (test-extlambda string #!optional whatever)
     151    string))
     152
     153(import m14)
     154
     155(test-equal "extended lambda list uses expansion environment"
     156            "some text"
     157            (test-extlambda "some text"))
     158
    148159(test-end "modules")
  • chicken/branches/prerelease/tests/path-tests.scm

    r13240 r15229  
    1818(assert (equal? "q/abc" (pathname-directory "q/abc/.def.ghi")))
    1919(assert (equal? "q/abc" (pathname-directory "q/abc/.ghi")))
     20
     21(define-syntax test
     22  (syntax-rules ()
     23    ((_ expected exp)
     24     (let ((result exp)
     25           (expd expected))
     26       (unless (equal? result expd)
     27         (error "test failed" result expd 'exp))))))
     28
     29(test "./" (normalize-pathname "" 'unix))
     30(test ".\\" (normalize-pathname "" 'windows))
     31(test "./" (normalize-pathname "/" 'unix))
     32(test "./" (normalize-pathname "./" 'unix))
     33(test "a" (normalize-pathname "a"))
     34(test "a/" (normalize-pathname "a/" 'unix))
     35(test "a/b" (normalize-pathname "a/b" 'unix))
     36(test "a/b" (normalize-pathname "a\\b" 'unix))
     37(test "a\\b" (normalize-pathname "a\\b" 'windows))
     38(test "a\\b" (normalize-pathname "a/b" 'windows))
     39(test "a/b/" (normalize-pathname "a/b/" 'unix))
     40(test "a/b/" (normalize-pathname "a/b//" 'unix))
     41(test "a/b" (normalize-pathname "a//b" 'unix))
     42(test "/a/b" (normalize-pathname "/a//b" 'unix))
     43(test "/a/b" (normalize-pathname "///a//b" 'unix))
     44(test "c:a\\b" (normalize-pathname "c:a/./b" 'windows))
     45(test "c:/a/b" (normalize-pathname "c:/a/./b" 'unix))
     46(test "c:a\\b" (normalize-pathname "c:a/./b" 'windows))
     47(test "c:b" (normalize-pathname "c:a/../b" 'windows))
     48(test "c:\\b" (normalize-pathname "c:\\a\\..\\b" 'windows))
     49(test "a/b" (normalize-pathname "a/./././b" 'unix))
     50(test "a/b" (normalize-pathname "a/b/c/d/../.." 'unix))
     51(test "a/b/" (normalize-pathname "a/b/c/d/../../" 'unix))
     52
     53(define home (get-environment-variable "HOME"))
     54
     55(test (string-append home "/foo") (normalize-pathname "~/foo" 'unix))
     56(test "c:~/foo" (normalize-pathname "c:~/foo" 'unix))
     57(test (string-append home "\\foo") (normalize-pathname "c:~\\foo" 'windows))
  • chicken/branches/prerelease/tests/runtests.sh

    r15228 r15229  
    145145
    146146echo "======================================== path tests ..."
    147 $compile path-tests.scm
    148 ./a.out
     147$interpret -bnq path-tests.scm
    149148
    150149echo "======================================== regular expression tests ..."
  • chicken/branches/prerelease/types.db

    r15101 r15229  
    329329(get-output-string (procedure get-output-string (port) string))
    330330(get-properties (procedure get-properties (symbol list) symbol * list))
    331 (getenv (procedure getenv (string) (or string boolean)))
     331(getenv deprecated)
    332332(getter-with-setter (procedure getter-with-setter (procedure procedure) procedure))
    333333(implicit-exit-handler (procedure implicit-exit-handler (#!optional procedure) procedure))
     
    634634(call-with-input-pipe (procedure call-with-input-pipe (string (procedure (port) . *) #!optional symbol) . *))
    635635(call-with-output-pipe (procedure call-with-output-pipe (string (procedure (port) . *) #!optional symbol) . *))
    636 (canonical-path (procedure canonical-path (string) string))
     636(canonical-path deprecated)
    637637(change-directory (procedure change-directory (string) undefined))
    638638(change-file-mode (procedure change-file-mode (string fixnum) undefined))
Note: See TracChangeset for help on using the changeset viewer.