Changeset 6200 in project


Ignore:
Timestamp:
09/30/07 04:30:29 (14 years ago)
Author:
Kon Lovett
Message:

Added tests (finally).

Location:
misc-extn/trunk
Files:
6 added
8 edited

Legend:

Unmodified
Added
Removed
  • misc-extn/trunk/misc-extn-condition-support.scm

    r5437 r6200  
    5353                   (lambda (cell)
    5454                     (if is-value
    55                        (begin (set! is-value #f) #t)
    56                        (begin
    57                          (set! is-value #t)
    58                          (and (pair? cell)
    59                               (let ([key (car cell)])
    60                                 (pair? key)
    61                                 (symbol? (car key))
    62                                 (symbol? (cdr key)) ) ) ) ) )
     55                         (begin (set! is-value #f) #t)
     56                         (begin
     57                           (set! is-value #t)
     58                           (and (pair? cell)
     59                                (let ([key (car cell)])
     60                                  (pair? key)
     61                                  (symbol? (car key))
     62                                  (symbol? (cdr key)) ) ) ) ) )
    6363                   obj) )
    6464      (error loc "invalid condition property list" obj) ) ) )
     
    7070    (let loop ([props (condition-property-list cnd)] [acc init])
    7171      (if (null? props)
    72         acc
    73         (let* ([key (car props)]
    74                [next1 (cdr props)]
    75                [next2 (cdr next1)])
    76           (if (eq? kind-key (car key))
    77             (loop next2 (proc (cdr key) (car next1) acc))
    78             (loop next2 acc)))) ) ) )
     72          acc
     73          (let* ([key (car props)]
     74                 [next1 (cdr props)]
     75                 [next2 (cdr next1)])
     76            (if (eq? kind-key (car key))
     77                (loop next2 (proc (cdr key) (car next1) acc))
     78                (loop next2 acc)))) ) ) )
    7979
    8080(define (%condition-properties-fold/list proc cnd kind-key)
     
    135135(define (condition-explode cnd)
    136136  (check-condition cnd 'condition-explode)
    137   (map
    138     (lambda (kind-key)
    139       (cons kind-key (condition-properties cnd kind-key)) )
    140     (condition-kind-keys cnd)) )
     137  (map (lambda (kind-key) (cons kind-key (condition-properties cnd kind-key)))
     138       (condition-kind-keys cnd)) )
    141139
    142140(define (make-property-condition/list kinds props)
  • misc-extn/trunk/misc-extn-control.scm

    r5438 r6200  
    1212            (let loop ([forms ?forms] [lst '()])
    1313              (if (null? forms)
    14                 (reverse lst)
    15                 (let ([tcase (car forms)])
    16                   (if (pair? tcase)
    17                     (let ([typ (car tcase)])
    18                       (loop
    19                         (cdr forms)
    20                         (cons
    21                           (cons
    22                             (cond
    23                               [(eq? 'else typ)
    24                                 'else]
    25                               [(symbol? typ)
    26                                 (make-type-pred typ)]
    27                               [(pair? typ)
    28                                 `(or ,@(map make-type-pred typ))]
    29                               [else
    30                                 (syntax-error loc "invalid case" tcase)])
    31                             (cdr tcase))
    32                           lst)))
    33                     (syntax-error loc "invalid case" tcase)))))))) )
     14                  (reverse lst)
     15                  (let ([tcase (car forms)])
     16                    (if (pair? tcase)
     17                        (let ([typ (car tcase)])
     18                          (loop
     19                            (cdr forms)
     20                            (cons
     21                              (cons
     22                                (cond [(eq? 'else typ)
     23                                        'else]
     24                                      [(symbol? typ)
     25                                        (make-type-pred typ)]
     26                                      [(pair? typ)
     27                                        `(or ,@(map make-type-pred typ))]
     28                                      [else
     29                                        (syntax-error loc "invalid case" tcase)])
     30                                (cdr tcase))
     31                              lst)))
     32                        (syntax-error loc "invalid case" tcase)))))))) )
    3433
    3534(define-macro (typecase ?expr . ?forms)
     
    4948  (let ([TMP-VAR (gensym "tmp")])
    5049    `(let ([,TMP-VAR ,A])
    51       (set! ,A ,B)
    52       (set! ,B ,TMP-VAR))))
     50       (set! ,A ,B)
     51       (set! ,B ,TMP-VAR))))
    5352
    5453;; Parallel chained set
     
    6059      (let ([todo (cddr todo)])
    6160        (if (null? todo)
    62           `(set! ,VAR ,VAL)
    63           (let ([TMP-VAR (gensym)])
    64             `(let ([,TMP-VAR ,VAL])
    65               ,(loop todo)
    66               (set! ,VAR ,TMP-VAR) ) ) ) ) ) ) )
     61            `(set! ,VAR ,VAL)
     62            (let ([TMP-VAR (gensym)])
     63              `(let ([,TMP-VAR ,VAL])
     64                 ,(loop todo)
     65                 (set! ,VAR ,TMP-VAR) ) ) ) ) ) ) )
    6766
    6867;; Serial chained set (CL SETQ like)
     
    7271    ,@(let loop ([todo REST] [lst '()])
    7372      (if (null? todo)
    74         lst
    75         (loop (cddr todo) (cons `(set! ,(car todo) ,(cadr todo)) lst)) ) ) ) )
     73          lst
     74          (loop (cddr todo) (cons `(set! ,(car todo) ,(cadr todo)) lst)) ) ) ) )
    7675
    7776;; Assign the result of the operation on the variable to itself
     
    8382      ,@(let loop ([iargs REST] [oargs '()])
    8483          (if (null? iargs)
    85             (cons VAR REST)
    86             (let ([arg (car iargs)]
    87                   [todo (cdr iargs)])
    88               (if (eq? '<> arg)
    89                 (append (reverse (cons VAR oargs)) todo)
    90                 (loop todo (cons arg oargs)) ) ) ) ) ) ) )
     84              (cons VAR REST)
     85              (let ([arg (car iargs)]
     86                    [todo (cdr iargs)])
     87                (if (eq? '<> arg)
     88                    (append (reverse (cons VAR oargs)) todo)
     89                    (loop todo (cons arg oargs)) ) ) ) ) ) ) )
    9190
    9291;;
     
    10099            (lambda (VAR)
    101100              (if (pair? VAR)
    102                 (let ([KEY (cadr VAR)] [REST (cddr VAR)])
    103                   (if (symbol? KEY)
    104                      `(hash-table-ref ,HASH ',KEY ,@REST)
    105                      `(hash-table-ref ,HASH ,KEY ,@REST)))
    106                   `(hash-table-ref ,HASH ',VAR)))
     101                  (let ([KEY (cadr VAR)] [REST (cddr VAR)])
     102                    (if (symbol? KEY)
     103                         `(hash-table-ref ,HASH ',KEY ,@REST)
     104                         `(hash-table-ref ,HASH ,KEY ,@REST)))
     105                    `(hash-table-ref ,HASH ',VAR)))
    107106            VARS)]
    108107        [ARGS
  • misc-extn/trunk/misc-extn-eggdoc.scm

    r5702 r6200  
    2727
    2828(define examples '((pre #<<EOF
    29 (use misc-extn-control)
     29(use misc-extn-control misc-extn-dsssl)
    3030
    3131(hash-let ([name (foo "wow")] some-hashtable)
     
    4343  [else
    4444    (error "not what I want" it)])
     45
     46;
     47(define (a1 a2 #!optional o1 o2 #!rest rest #!key k1 k2)
     48  (dsssl-fixup '(#:k1 #:k2) ((o1 'x) (o2 'y)) rest
     49    (list o1 o2 rest) ) )
     50; expands into something similar to
     51#;
     52(define (a1 a2 #!optional o1 o2 #!rest rest #!key k1 k2)
     53  (let-values ([(rest o1 o2)
     54                (fixup-extended-lambda-list '(#:k1 #:k2) rest (list o1 'x) (list o2 'y))])
     55    (list o1 o2 rest) ) )
    4556EOF
    4657)))
     
    5162    (description (p "Provides miscellaneous useful stuff."))
    5263    (author (url "mailto:klovett@pacbell.net" "Kon Lovett"))
     64    (download "misc-extn.egg")
     65
     66    (documentation
     67
     68      (subsection "Record Types"
     69
     70        (usage "(require-extension misc-extn-record)")
     71
     72        (macro "(define-unchecked-record-type T CTOR PRED [SLOT ...])"
     73          (p "SRFI-9 '(define-record-type T CTOR PRED [SLOT ...])', "
     74          "except no checks are made for correct record type before slot "
     75          "access, and the record type symbol is not defined.")
     76
     77          (p "For use when slot access is attempted " (i "only") " after "
     78          "determining the correct record type explicitly. Do " (i "not") " "
     79          "make constructed slot access procedures part of a public "
     80          "API."))
     81
     82        (macro "(define-inline-unchecked-record-type T CTOR PRED [SLOT ...])"
     83          (p "SRFI-9 '(define-record-type T CTOR PRED [SLOT ...])', "
     84          "except no checks are made for correct record type before slot "
     85          "access, the record type symbol is not defined, and  "
     86          "procedures are inline.")
     87
     88          (p "For use when slot access is attempted " (i "only") " after "
     89          "determining the correct record type explicitly."))
     90      )
     91
     92      (subsection "Control Forms"
     93
     94        (usage "(require-extension misc-extn-control)")
     95
     96        (macro "(typecase EXPRESSION [(TYPE-TEST BODY ...) ...])"
     97          (p "Expands into a " (code "cond") " form where every case test is a "
     98          "type test.")
     99
     100          (p "A " (tt "TYPE-TEST") " is either a symbol, which must "
     101          "be the base symbol of a type predicate, a non-null list, which must "
     102          "be a list of the base symbols of type predicates, or the symbol "
     103          (code "else") ". An example of a base symbol of a type predicate is "
     104          (code "symbol") " and the procedure " (code "(symbol? OBJECT)") " "
     105          "is used for the test.")
     106
     107          (p "The " (tt "BODY") " is not processed. It must be legal as the "
     108          "body of a " (code "cond") " case.") )
     109
     110        (macro "(typecase* EXPRESSION [(TYPE-TEST BODY ...) ...])"
     111          (p "Like " (code "typecase") " but binds local variable " (code "it") " "
     112          "to the value of " (tt "EXPRESSION") ".") )
     113
     114        (macro "(whennot TEST [BODY ...])"
     115          (p "Synonym for " (code "unless") ".") )
     116
     117        (macro "(swap-set! VAR1 VAR2)"
     118          (p "Swap settings of " (tt "VAR1") " & " (tt "VAR2") "."))
     119
     120        (macro "(fluid-set! VAR VAL ...)"
     121          (p "Set each variable " (tt "VAR") " to the value "
     122          (tt "VAL") " in parallel."))
     123
     124        (macro "(stiff-set! VAR VAL ...)"
     125          (p "Set each variable " (tt "VAR") " to the value "
     126          (tt "VAL") " in series."))
     127
     128        (macro "(hash-let (([VAR | (VAR KEY)] ...) HASH-TABLE) BODY ...)"
     129          (p "Decompose " (tt "HASH-TABLE") " entries into variable "
     130          "bindings. Should the " (tt "KEY") " not be symbol, or the "
     131          "desired variable name " (tt "VAR") " should not be the key, "
     132          "the '(VAR KEY)' form can be used. The " (tt "BODY ...") " is "
     133          "evaluated with the specified bindings."))
     134
     135        (macro "(set!/op VAR OP ARG ...)"
     136          (p "Sets " (tt "VAR") " to the value of " (code "(OP ARG ...)") ", where "
     137          "the first occurrence of " (code "<>") " in " (tt "ARG ...") " is "
     138          "replaced with " (tt "VAR") ".")
     139
     140          (p "When there is no occurrence of " (code "<>") " in " (tt "ARG ...")
     141          "the template " (tt "(OP <> ARG ...)") " is used.") )
     142
     143        (procedure "(assure EXPRESSION [ERROR-ARGUMENT ...])"
     144          (p "When " (tt "EXPRESSION") " yields " (code "#f") " invoke "
     145          (code "(error ERROR-ARGUMENT ...)") ", otherwise return value."))
     146
     147        (procedure "(identify-error [CALLER] MSG ARGS ...)"
     148          (p "Prints a message like " (tt "(error ...)") " to "
     149          (tt "(current-error-port)") " but does not throw an exception."))
     150
     151        (procedure "(errorf [ID] [FORMAT-STRING ARGS ...])"
     152          (p "Same as '(error [ID] (sprintf FORMAT-STRING ARGS ...))'.")
     153
     154          (p "The actual argument for the returned procedure is to be a "
     155          "procedure which will be applied with the evaluated expressions "
     156          "as the actual argument list."))
     157      )
     158
     159      (subsection "Lists"
     160
     161        (usage "(require-extension misc-extn-list)")
     162
     163        (p "The following macros are also availabe as procedures.")
     164
     165        (macro "(length=0? LIST)"
     166          (p "List of length zero?"))
     167
     168        (macro "(length=1? LIST)"
     169          (p "List of length one?"))
     170
     171        (macro "(length=2? LIST)"
     172          (p "List of length two?"))
     173
     174        (macro "(length>1? LIST)"
     175          (p "List of length greater than one?"))
     176
     177        (macro "(shift!/set VARIABLE [WHEN-EMPTY])"
     178          (p "Like " (code "shift!") " in the utils unit but assigns the "
     179          (tt "VARIABLE") " " (code "'()") " after shifting from a "
     180          "list of length 1.")
     181
     182          (p (tt "WHEN-EMPTY") ", which defaults to " (code "#f") " is returned "
     183          "when the list bound to " (tt "VARIABLE") " is empty.") )
     184
     185        (macro "(ensure-list OBJECT)"
     186          (p "Returns a list, either the list " (tt "OBJECT") " or "
     187          (code "(list OBJECT)") ".") )
     188
     189        (macro "(not-null? LIST)"
     190          (p "Returns " (code "#f") " if the given " (tt "LIST") " is empty, and "
     191          (tt "LIST") " otherwise."))
     192     )
     193
     194      (subsection "Association Lists"
     195
     196        (usage "(require-extension misc-extn-list)")
     197
     198        (procedure "(alist-inverse-ref VALUE ALIST [TEST? [NOT-FOUND]])"
     199          (p "Returns the first key associated with " (tt "VALUE") " in "
     200          "the " (tt "ALIST") " using the " (tt "TEST?") " predicate, "
     201          "else " (tt "NOT-FOUND") ".")
     202
     203          (p (tt "TEST?") " is " (code "eqv?") " and " (tt "NOT-FOUND") " is " (code "#f") ".") )
     204
     205        (procedure "(alist-delete/count KEY ALIST [TEST? [COUNT]])"
     206          (p "Deletes the first (tt "COUNT") associations from alist "
     207          (tt "ALIST") "with the given key " (tt "KEY") ", using key-comparison "
     208          "procedure " (tt "TEST?") ". The dynamic order in which the "
     209          "various applications of equality are made is from the alist "
     210          "head to the tail.")
     211
     212          (p "Returns a new alist. The alist is not disordered - elements that appear "
     213          "in the result alist occur in the same order as they occur in "
     214          "the argument alist.")
     215
     216          (p "The equality procedure is used to compare the element "
     217          "keys, 'key[i: 0 <= i < (length ALIST)]', of the alist's "
     218          "entries to the key parameter in this way: '(TEST? KEY "
     219          "key[i])'.")
     220
     221          (p (tt "COUNT") " defaults to essentially, infinity, and " (tt "EQUALITY?")
     222          " defaults to " (code "eqv?") ".") )
     223
     224        (procedure "(alist-delete!/count KEY ALIST [TEST? [COUNT]])"
     225          (p "Destructive version of " (code "alist-delete/count") ".") )
     226
     227        (p (code "alist-delete-first") " and " (code "alist-delete-first!") " "
     228        "are also available as procedures.")
     229
     230        (macro "(alist-delete-first KEY ALIST [TEST?])"
     231          (p "Returns " (code "(alist-delete/count KEY ALIST 1 [TEST?])") ".") )
     232
     233        (macro "(alist-delete-first! KEY ALIST [TEST?])"
     234          (p "Destructive version of " (code "alist-delete-first") ".") )
     235
     236        (procedure "(unzip-alist ALIST)"
     237          (p "Returns 2 values, a list of the keys & a list of the values from
     238          the " (tt "ALIST") ".") )
     239
     240        (procedure "(zip-alist KEYS VALUES)"
     241          (p "Returns an association list with elements from the corresponding items of "
     242          (tt "KEYS") " and " (tt "VALUES") ".") )
     243
     244        (p "Error signaling versions of the standard association lookup functions. "
     245        "When the " (tt "KEY") " is not found and a " (tt "NOT-FOUND") " value "
     246        "is not supplied an " (code "error") " is invoked.")
     247
     248        (macro "(assoc-def KEY ALIST [TEST] [NOT-FOUND])"
     249          (p "The assoc procedure with an optional test and default "
     250          "value."))
     251
     252        (macro "(assv-def KEY ALIST [NOT-FOUND])"
     253          (p "The assv procedure with a default value."))
     254
     255        (macro "(assq-def KEY ALIST [NOT-FOUND])"
     256          (p "The assq procedure with a default value."))
     257      )
     258
     259      (subsection "DSSSL Extended Lambda List"
     260
     261        (usage "(require-extension misc-extn-dsssl)")
     262
     263        (procedure "(filter-rest-argument! REST-LIST [PREDICATE | LIST-OF-KEYWORD])"
     264          (p "Destructively remove any keywords & keyword+value items from a "
     265          (code "#!rest") " argument list.")
     266
     267          (p "When the optional predicate is supplied it must return "
     268          (code "#t") " or " (code "#f") " indicating whether the item "
     269          "is to kept or removed. The predicate takes the current item.")
     270
     271          (p "When the optional keyword list is supplied only keywords & "
     272          "keyword+value items from the list are removed."))
     273
     274        (procedure "(fixup-extended-lambda-list-rest LIST-OF-KEYWORD REST-LIST)"
     275          (p "Returns a list from " (tt "REST-LIST") " with all key'ed pairs "
     276          "from " (tt "LIST-OF-KEYWORD") " removed.") )
     277
     278        (procedure "(fixup-extended-lambda-list-optional LIST-OF-KEYWORD OPTIONAL ...)"
     279          (p "Returns N+1 values from " (tt "OPTIONAL ...") ", where N is the "
     280          "number of optionals, with all key'ed pairs from " (tt "LIST-OF-KEYWORD") " "
     281          "removed. The first return value is the 'skip?' flag, the remaining are the "
     282          "\"fixed\" optional values.")
     283
     284          (p (tt "OPTIONAL") " is a list of the form " (code "(VALUE DEFAULT)") ".")
     285
     286          (p "The optionals run left-to-right, and the key/value pairs are "
     287          "assumed to bind left-to-right.") )
     288
     289        (procedure "(fixup-extended-lambda-list LIST-OF-KEYWORD REST-LIST [OPTIONAL ...])"
     290          (p "Returns N+1 values where the 1st value is the \"fixed\" "
     291          (tt "REST-LIST") " and the remaining values are the \"fixed\" "
     292          (tt "OPTIONAL ...") ".") )
     293
     294        (macro "(dsssl-fixup LIST-OF-KEYWORD LIST-OF-OPTIONAL REST-VARIABLE BODY ...)"
     295          (p "Expands the " (tt "BODY ...") " in a new lexical scope with the "
     296          "optional and rest variables bound to the \"fixed\" values.")
     297
     298          (p (tt "LIST-OF-OPTIONAL") " is a list of elements of the form "
     299          (code "(VARIABLE DEFAULT)") " where " (tt "VARIABLE") " is the optional "
     300          "variable name and " (tt "DEFAULT") " is the optional variable default value.") )
     301      )
     302
     303      (subsection "Arithmetic"
     304
     305        (usage "(require-extension misc-extn-numeric)")
     306
     307        (macro "(inc VAL)"
     308          (p "Read-only increment."))
     309
     310        (macro "(dec VAL)"
     311          (p "Read-only decrement."))
     312
     313        (macro "(++ VAL)"
     314          (p "Read-only increment."))
     315
     316        (macro "(-- VAL)"
     317          (p "Read-only decrement."))
     318
     319        (macro "(fx++ VAL)"
     320          (p "Read-only fixnum increment."))
     321
     322        (macro "(fx-- VAL)"
     323          (p "Read-only fixnum decrement."))
     324
     325        (macro "(fp++ VAL)"
     326          (p "Read-only flonum increment."))
     327
     328        (macro "(fp-- VAL)"
     329          (p "Read-only flonum decrement."))
     330
     331        (macro "(++! VAR)"
     332          (p "Mutable increment."))
     333
     334        (macro "(--! VAR)"
     335          (p "Mutable decrement."))
     336
     337        (macro "(fx++! VAR)"
     338          (p "Mutable fixnum increment."))
     339
     340        (macro "(fx--! VAR)"
     341          (p "Mutable fixnum decrement."))
     342
     343        (macro "(fp++! VAR)"
     344          (p "Mutable flonum increment."))
     345
     346        (macro "(fp--! VAR)"
     347          (p "Mutable flonum decrement."))
     348      )
     349
     350      (subsection "Posix"
     351
     352        (usage "(require-extension misc-extn-posix)")
     353
     354        (procedure "(replace-fileno NEW-FILENO KNOWN-FILENO)"
     355          (p "Replaces the meaning of " (tt "KNOWN-FILENO") " with "
     356          (tt "NEW-FILENO") ". I/O Redirection.") )
     357
     358        (procedure "(create-directory/parents DIRECTORY)"
     359          (p "Ensures the directory pathname " (tt "DIRECTORY") " exists.")
     360
     361          (p "Like the UNIX `\"mkdir -p DIRECTORY\" command.") )
     362
     363        (procedure "(create-pathname-directory PATHNAME)"
     364          (p "Ensures the directory component of " (tt "PATHNAME") " exist.")
     365
     366          (p "Like the UNIX `\"mkdir -p `dirname PATHNAME`\" command.") )
     367
     368        (procedure "(make-program-filename COMMAND)"
     369          (p "Returns the platform specific form of an executable command "
     370          "filename.")
     371
     372          (p "On Windows the " (code "exe") " extension is added unless an "
     373          "extension is already present. Does nothing on other platforms.") )
     374
     375        (procedure "(file-exists/directory? FILENAME [DIRECTORY | DIRECTORY-LIST])"
     376          (p "Returns the pathname when " (tt "FILENAME") " exists in the "
     377          (tt "DIRECTORY") ", otherwise " (code "#f") ".")
     378
     379          (p (tt "DIRECTORY-LIST") " is as for " (code "make-pathname") ".")
     380
     381          (p "When only the " (tt "FILENAME") " parameter supplied then the "
     382          "same as " (code "file-exists?") ".") )
     383
     384        (procedure "(find-file-pathnames FILENAME [DIRECTORY | DIRECTORY-LIST] ...)"
     385          (p "Returns a list of all pathnames found for " (tt "FILENAME") " in "
     386          "the supplied directory/directories, or " (code "#f") " when not found.")
     387
     388          (p "The list of pathnames is in the same relative order as that of "
     389          "the directory parameter(s).") )
     390
     391        (procedure "(find-program-pathnames COMMAND-NAME [DIRECTORY | DIRECTORY-LIST] ...)"
     392          (p "Returns a list of all pathnames found for " (tt "COMMAND-NAME") " in "
     393          "the supplied directory/directories, or " (code "#f") " when not found.")
     394
     395          (p "Uses " (code "make-program-filename") " to make a filename.")
     396
     397          (p "Does not ensure that the file is executable!") )
     398
     399        (procedure "(which-command-pathname COMMAND-NAME [ENVIRONMENT-VARIABLE "PATH"])"
     400          (p "Returns the first directory in the " (tt "ENVIRONMENT-VARIABLE") " "
     401          "where a file named " (tt "COMMAND-NAME") " exists, "
     402          "or " (code "#f") " when nothing found.")
     403
     404          (p "Uses the platform specific PATH environment variable element "
     405          "separator - a semi-colon for Windows, & a colon otherwise.")
     406
     407          (p "Like the UNIX \"which COMMAND-NAME\" command.") )
     408
     409        (procedure "(remove-dotfiles FILES)"
     410          (p "Remove dot files from a directory list. Useful with " (code "glob") "."))
     411
     412                                (subsubsection "Scheduling Priority"
     413
     414          (p "Parameter Descriptions")
     415          (symbol-table
     416            (describe priority/process
     417              "Process WHICH - WHO is 0 for current process or a process identifier.")
     418            (describe priority/process-group
     419              "Process Group WHICH - WHO is 0 for current process group or a process group identifier.")
     420            (describe priority/user
     421              "User WHICH - WHO is 0 for current user or a user identifier.")
     422            (describe PRIORITY
     423              "An integer [-20 20].") )
     424          (br)
     425
     426          (procedure "(scheduling-priority WHICH WHO)"
     427            (p "Returns the priority of " (tt "WHO") " of kind " (tt "WHICH") ".") )
     428
     429          (procedure "(set-scheduling-priority! WHICH WHO PRIORITY)"
     430            (p "Sets the priority of " (tt "WHO") " of kind " (tt "WHICH") " to "
     431            (tt "PRIORITY") ".") )
     432        )
     433
     434                                (subsubsection "Pseudo-TTY"
     435
     436          (p "Currently a thin wrapper around the C interface. Scheme bindings "
     437          "for the necessary C constants are not provided.")
     438
     439          (procedure "(alloc-winsize)"
     440            (p "Returns the pointer to a new C struct winsize.") )
     441
     442          (procedure "(free-winsize (nonnull-pointer WINSIZE))"
     443            (p "Releases a C struct winsize.") )
     444
     445          (p "Accessors for a struct winsize")
     446          (symbol-table
     447            (describe winsize-col "Returns ws_col")
     448            (describe winsize-col-set! "Sets ws_col")
     449            (describe winsize-row "Returns ws_row")
     450            (describe winsize-row-set! "Sets ws_row")
     451            (describe winsize-xpixel "Returns ws_xpixel")
     452            (describe winsize-xpixel-set! "Sets ws_xpixel")
     453            (describe winsize-ypixel "Returns ws_ypixel")
     454            (describe winsize-ypixel-set! "Sets ws_ypixel") )
     455          (br)
     456
     457          (procedure "(alloc-termios)"
     458            (p "Returns the pointer to a new C struct termios.") )
     459
     460          (procedure "(free-termios (nonnull-pointer TERMIOS))"
     461            (p "Releases a C struct termios.") )
     462
     463          (p "Accessors for a struct termios")
     464          (symbol-table
     465            (describe termios-cc "Returns c_cc[idx]")
     466            (describe termios-cc-set! "Sets c_cc[idx]")
     467            (describe termios-cflag "Returns c_cflag")
     468            (describe termios-cflag-set! "Sets c_cflag")
     469            (describe termios-iflag "Returns c_iflag")
     470            (describe termios-iflag-set! "Sets c_iflag")
     471            (describe termios-lflag "Returns c_lflag")
     472            (describe termios-lflag-set! "Sets c_lflag")
     473            (describe termios-oflag "Returns c_oflag")
     474            (describe termios-oflag-set! "Sets c_oflag")
     475            (describe termios-ispeed "Returns c_ispeed")
     476            (describe termios-ispeed-set! "Sets c_ispeed")
     477            (describe termios-ospeed "Returns c_ospeed")
     478            (describe termios-ospeed-set! "Sets c_ospeed") )
     479          (br)
     480
     481          (procedure "(login-tty SLAVE-FILENO)"
     482            (p "The C procedure.") )
     483
     484          (procedure "(open-pty (nonnull-pointer MASTER-FILENO) (nonnull-pointer SLAVE-FILENO) (c-string NAME) (pointer WINSIZE) (pointer TERMIOS))"
     485            (p "The C procedure.") )
     486        )
     487      )
     488
     489      (subsection "Symbol"
     490
     491        (usage "(require-extension misc-extn-symbol)")
     492
     493        (macro "(unbound-value)"
     494          (p "Returns the value representing \"unbound\".") )
     495
     496        (macro "(unbound-value? OBJECT)"
     497          (p "Is the " (tt "OBJECT") " the unbound value?") )
     498
     499        (macro "(unbound? SYMBOL)"
     500          (p "Is the " (tt "SYMBOL") " unbound?")
     501
     502          (p (tt "SYMBOL") " is " (b "not") " treated as a literal, be "
     503          "sure to quote if a literal desired.") )
     504
     505        (macro "(symbol-value SYMBOL [NOT-FOUND #f])"
     506          (p "Returns the " (tt "SYMBOL") " binding when bound, "
     507          "otherwise the " (tt "NOT-FOUND") ".")
     508
     509          (p (tt "SYMBOL") " is " (b "not") " treated as a literal, be "
     510          "sure to quote if a literal desired.") )
     511
     512        (macro "(undefined-value)"
     513          (p "Returns the value representing \"undefined\".") )
     514
     515        (macro "(undefined-value? OBJECT)"
     516          (p "Is the " (tt "OBJECT") " the undefined value?") )
     517
     518        (macro "(undefined? OBJECT)"
     519          (p "Is the " (tt "OBJECT") " the undefined value?") )
     520
     521        (procedure "(make-qualified-symbol NAMESPACE SYMBOL)"
     522          (p "Returns the Chicken namespace qualified " (tt "SYMBOL") " for the "
     523          (tt "NAMESPACE") ".")
     524
     525          (p "An exception is generated when the " (tt "NAMESPACE") " "
     526          "length exceeds the system limit.") )
     527
     528        (procedure "(make-qualified-uninterned-symbol NAMESPACE SYMBOL)"
     529          (p "Returns the Chicken namespace qualified " (tt "SYMBOL") " for the "
     530          (tt "NAMESPACE") ".") )
     531
     532        (procedure "(qualified-symbol? SYMBOL)"
     533          (p "Is the " (tt "SYMBOL") " a Chicken namespace qualified symbol."))
     534
     535        (procedure "(symbol->qualified-string SYMBOL)"
     536          (p "Returns the printname of a Chicken namespace qualified " (tt "SYMBOL") "."))
     537
     538        (procedure "(interned-symbol? SYMBOL)"
     539          (p "Is the " (tt "SYMBOL") " interned?"))
     540      )
     541
     542      (subsection "Conditions"
     543
     544        (usage "(require-extension misc-extn-condition)")
     545
     546        (p "The build condition API macros are currently " (b "unavailable") " when using "
     547        (b "hygienic") " macros.")
     548
     549        (macro "(build-condition-naming-api FORM ...)"
     550          (p "Expands into one or more macros that expand into a condition specification "
     551          "form, suitable for use with " (code "build-property-condition-api") " and "
     552          (code "build-composite-condition-api") ".")
     553
     554          (p "Example: "
     555          (code "(build-condition-naming (exn location message arguments) foo (bar rope))"))
     556
     557          (p "Creates the following:")
     558
     559          (ul
     560            (li (code "(define-macro (exn-condition) '(exn location message arguments))") )
     561            (li (code "(define-macro (foo-condition) 'foo)") )
     562            (li (code "(define-macro (bar-condition) '(bar rope))") ) ) )
     563
     564        (macro "(build-property-condition-api FORM ...)"
     565          (p "Expands into a suite of procedures to construct and test SRFI-12 property "
     566          "condition objects.")
     567
     568          (p "When only one " (tt "FORM") " is supplied a single property condition API is "
     569          "built. When more than one " (tt "FORM") " are supplied then all the property "
     570          "condition APIs are built.")
     571
     572          (p "When " (tt "FORM") " is a symbol it is a condition " (tt "KIND-KEY") " and "
     573          "identifies a condition without properties. When " (tt "FORM") " is a list the first "
     574          "element is the condition " (tt "KIND-KEY") " and the following elements are property "
     575          "keys.")
     576
     577          (p "A condition constructor is named as " (tt "make-KIND-KEY-condition") " "
     578          "and has 0 or more formal parameters, which are the property keys.")
     579
     580          (p "A condition predicate is named as " (tt "KIND-KEY-condition?") " "
     581          "and has 1 formal parameter, the object to test.")
     582
     583          (p "Property condition constructors without properties always return the same "
     584          "condition object!")
     585
     586          (p "Example: "
     587          (code "(build-property-condition-api (exn location message arguments) foo (bar rope))"))
     588
     589          (p "Creates the following:")
     590
     591          (ul
     592            (li (code "(make-exn-condition location message arguments)"))
     593            (li (code "(exn-condition? object)") )
     594            (li (code "(make-foo-condition)") )
     595            (li (code "(foo-condition? object)") )
     596            (li (code "(make-bar-condition rope)") )
     597            (li (code "(bar-condition? object)") ) ) )
     598
     599        (macro "(build-composite-condition-api FORM ...)"
     600          (p "Expands into a suite of procedures to construct and test SRFI-12 a composite "
     601          "condition object.")
     602
     603          (p (tt "FORM") " is the same as " (tt "FORM") " in the "
     604          (code "build-property-condition-api") " definition.")
     605
     606          (p "When zero or one " (tt "FORM") " are supplied nothing is built. When more than "
     607          "one " (tt "FORM") " are supplied then a composite API is built.")
     608
     609          (p "A composite condition constructor is like a property condition constructor, "
     610           "except that the " (tt "KIND-KEY") " is a concatenation of every condition "
     611           (tt "KEY") ", interspersed with a hyphen.")
     612
     613          (p "A composite condition predicate is like a property condition predicate, "
     614           "except that the " (tt "KIND-KEY") " is a concatenation of every condition "
     615           (tt "KEY") ", interspersed with a hyphen.")
     616
     617          (p "Example: "
     618          (code "(build-composite-condition-api (exn location message arguments) foo (bar rope))"))
     619
     620          (p "Creates the following:")
     621
     622          (ul
     623            (li (code "(make-exn-foo-bar-condition location message arguments rope)") )
     624            (li (code "(exn-foo-bar-condition? object)") ) ) )
     625
     626        (procedure "(handle-condition THUNK [HANDLER identity])"
     627          (p "Simplified " (code "with-exception-handler") " where the "
     628          (tt "HANDLER") " result is always returned to the caller.")
     629
     630          (p (tt "HANDLER") " is (-> condition object).") )
     631
     632        (procedure "(composite-condition? OBJECT [KIND-KEY ...])"
     633          (p "Is the " (tt "OBJECT") " a SRFI-12 composite condition?")
     634
     635          (p "When one or more " (tt "KIND-KEY") " are supplied then the composite condition "
     636          "must compose at least those kind keys.") )
     637
     638        (procedure "(condition-kind-keys CONDITION)"
     639          (p "Returns a list of the kind-keys of the SRFI-12 "
     640          (tt "CONDITION") ".") )
     641
     642        (procedure "(condition-property-keys CONDITION [KIND-KEY])"
     643          (p "Returns a list of the property-keys for " (tt "KIND-KEY") " "
     644          "of the SRFI-12 " (tt "CONDITION") ", or " (code "#f") " when no "
     645          "property keys or the " (tt "CONDITION") " is not of the kind "
     646          (tt "KIND-KEY") ".")
     647
     648          (p "When " (tt "KIND-KEY") " is missing some kind-key of the "
     649          (tt "CONDITION") " is used.") )
     650
     651        (procedure "(condition-properties CONDITION [KIND-KEY])"
     652          (p "Returns an association list of the property keys & values "
     653          "for " (tt "KIND-KEY") " of the SRFI-12 " (tt "CONDITION")
     654          ", or " (code "#f") " when no " "property keys or the "
     655          (tt "CONDITION") " is not of the kind " (tt "KIND-KEY") ".")
     656
     657          (p "When " (tt "KIND-KEY") " is missing some kind-key of the "
     658          (tt "CONDITION") " is used.") )
     659
     660        (procedure "(condition-explode CONDITION)"
     661          (p "Returns an association list of every kind-key of the "
     662          "SRFI-12 " (tt "CONDITION") ". The value of each entry is the "
     663          "result of " (code "(condition-properties CONDITION KIND-KEY") " "
     664          "for that " (tt "KIND-KEY") ".") )
     665
     666        (procedure "(make-property-condition/list KIND-LIST PROPERTY-LIST)"
     667          (p "Returns a new condition.")
     668
     669          (p (tt "KIND-LIST") " is a list of kind-key.")
     670
     671          (p (tt "PROPERTY-LIST") " is a property list, where the key "
     672          "element is a pair, (<kind-key> . <property-key>).") )
     673      )
     674
     675      (subsection "Input/Output"
     676
     677        (usage "(require-extension misc-extn-io)")
     678
     679        (procedure "(cout EXPR ...)"
     680          (p "Like cout << arguments << args where argument can be any "
     681          "Scheme object. If it's a procedure (without args) it's "
     682          "executed rather than printed (like newline)."))
     683
     684        (procedure "(cerr EXPR ...)"
     685          (p "Like cerr << arguments << args where argument can be any "
     686          "Scheme object. If it's a procedure (without args) it's "
     687          "executed rather than printed (like newline)."))
     688
     689        (constant "nl"
     690          (p "String form of the newline character."))
     691      )
     692     )
     693
     694    (section "Contributions"
     695
     696      (p "William Annis - hash-let.")
     697
     698      (p "Oleg Kiselyov's Standard Scheme \"Prelude\" - ++, ...")
     699    )
     700
     701    (examples ,examples)
     702
    53703    (history
     704      (version "3.003" "Added list macros. Deprecated alist-delete*. Added misc-extn-dsssl.")
    54705      (version "3.002" "Reverted to 3.0 behavior for unbound Wasn't a bug.")
    55706      (version "3.001" "Bugfix for unbound")
     
    81732      (version "1.0" "Initial release"))
    82733
    83     (download "misc-extn.egg")
    84 
    85     (documentation
    86 
    87       (subsection "Record Types"
    88 
    89         (usage "(require-extension misc-extn-record)")
    90 
    91         (macro "(define-unchecked-record-type T CTOR PRED [SLOT ...])"
    92           (p "SRFI-9 '(define-record-type T CTOR PRED [SLOT ...])', "
    93           "except no checks are made for correct record type before slot "
    94           "access, and the record type symbol is not defined.")
    95 
    96           (p "For use when slot access is attempted " (i "only") " after "
    97           "determining the correct record type explicitly. Do " (i "not") " "
    98           "make constructed slot access procedures part of a public "
    99           "API."))
    100 
    101         (macro "(define-inline-unchecked-record-type T CTOR PRED [SLOT ...])"
    102           (p "SRFI-9 '(define-record-type T CTOR PRED [SLOT ...])', "
    103           "except no checks are made for correct record type before slot "
    104           "access, the record type symbol is not defined, and  "
    105           "procedures are inline.")
    106 
    107           (p "For use when slot access is attempted " (i "only") " after "
    108           "determining the correct record type explicitly."))
    109       )
    110 
    111       (subsection "Control Forms"
    112 
    113         (usage "(require-extension misc-extn-control)")
    114 
    115         (macro "(typecase EXPRESSION [(TYPE-TEST BODY ...) ...])"
    116           (p "Expands into a " (code "cond") " form where every case test is a "
    117           "type test.")
    118 
    119           (p "A " (tt "TYPE-TEST") " is either a symbol, which must "
    120           "be the base symbol of a type predicate, a non-null list, which must "
    121           "be a list of the base symbols of type predicates, or the symbol "
    122           (code "else") ". An example of a base symbol of a type predicate is "
    123           (code "symbol") " and the procedure " (code "(symbol? OBJECT)") " "
    124           "is used for the test.")
    125 
    126           (p "The " (tt "BODY") " is not processed. It must be legal as the "
    127           "body of a " (code "cond") " case.") )
    128 
    129         (macro "(typecase* EXPRESSION [(TYPE-TEST BODY ...) ...])"
    130           (p "Like " (code "typecase") " but binds local variable " (code "it") " "
    131           "to the value of " (tt "EXPRESSION") ".") )
    132 
    133         (macro "(whennot CONDITION [BODY ...])"
    134           (p "Same as " (code "(unless CONDITION [BODY ...])") "."))
    135 
    136         (macro "(swap-set! VAR1 VAR2)"
    137           (p "Swap settings of " (tt "VAR1") " & " (tt "VAR2") "."))
    138 
    139         (macro "(fluid-set! VAR VAL ...)"
    140           (p "Set each variable " (tt "VAR") " to the value "
    141           (tt "VAL") " in parallel."))
    142 
    143         (macro "(stiff-set! VAR VAL ...)"
    144           (p "Set each variable " (tt "VAR") " to the value "
    145           (tt "VAL") " in series."))
    146 
    147         (macro "(hash-let (([VAR | (VAR KEY)] ...) HASH-TABLE) BODY ...)"
    148           (p "Decompose " (tt "HASH-TABLE") " entries into variable "
    149           "bindings. Should the " (tt "KEY") " not be symbol, or the "
    150           "desired variable name " (tt "VAR") " should not be the key, "
    151           "the '(VAR KEY)' form can be used. The " (tt "BODY ...") " is "
    152           "evaluated with the specified bindings."))
    153 
    154         (macro "(set!/op VAR OP ARG ...)"
    155           (p "Sets " (tt "VAR") " to the value of " (code "(OP ARG ...)") ", where "
    156           "the first occurrence of " (code "<>") " in " (tt "ARG ...") " is "
    157           "replaced with " (tt "VAR") ". When there is no occurrence of " (code "<>") " in " (tt "ARG ...")
    158           "the template " (tt "(OP <> ARG ...)") " is used.") )
    159 
    160         (procedure "(assure EXPRESSION [ERROR-ARGUMENT ...])"
    161           (p "When " (tt "EXPRESSION") " yields " (code "#f") " invoke "
    162           (code "(error ERROR-ARGUMENT ...)") ", otherwise return value."))
    163 
    164         (procedure "(identify-error [CALLER] MSG ARGS ...)"
    165           (p "Prints a message like " (tt "(error ...)") " to "
    166           (tt "(current-error-port)") " but does not throw an exception."))
    167 
    168         (procedure "(errorf [ID] [FORMAT-STRING ARGS ...])"
    169           (p "Same as '(error [ID] (sprintf FORMAT-STRING ARGS ...))'.")
    170 
    171           (p "The actual argument for the returned procedure is to be a "
    172           "procedure which will be applied with the evaluated expressions "
    173           "as the actual argument list."))
    174       )
    175 
    176       (subsection "Lists"
    177 
    178         (usage "(require-extension misc-extn-list)")
    179 
    180         (p "The length test macros terminate early when the test is satisfied; i.e they do not "
    181         "use " (code "length") ".")
    182 
    183         (macro "(length=0? LIST)"
    184           (p "List of length zero?"))
    185 
    186         (macro "(length=1? LIST)"
    187           (p "List of length one?"))
    188 
    189         (macro "(length=2? LIST)"
    190           (p "List of length two?"))
    191 
    192         (macro "(length>1? LIST)"
    193           (p "List of length greater than one?"))
    194 
    195         (macro "(shift!/set SYM [DEFAULT])"
    196           (p "Like " (code "shift!") " in the utils unit but assigns the "
    197           "variable " (tt "SYM") " the " (code "'()") " after shifting from a "
    198           "list of length 1."))
    199 
    200         (p "Error signaling versions of the standard association lookup functions. "
    201         "When the " (tt "KEY") " is not found and a " (tt "DEFAULT") " is not supplied an "
    202         (code "error") " is invoked.")
    203 
    204         (macro "(assoc-def KEY ALIST [TEST] [DEFAULT])"
    205           (p "The assoc procedure with an optional test and default "
    206           "value."))
    207 
    208         (macro "(assv-def KEY ALIST [DEFAULT])"
    209           (p "The assv procedure with a default value."))
    210 
    211         (macro "(assq-def KEY ALIST [DEFAULT])"
    212           (p "The assq procedure with a default value."))
    213 
    214         (procedure "(ensure-list OBJECT)"
    215           (p "Returns a list, either the list " (tt "OBJECT") " or "
    216           (code "(list OBJECT)") ".") )
    217 
    218         (procedure "(not-null? LIST)"
    219           (p "Returns " (code "#f") " if the given " (tt "LIST") " is empty, and "
    220           (tt "LIST") " otherwise."))
    221 
    222         (procedure "(filter-rest-argument! REST-LIST [PREDICATE | LIST-OF-KEYWORD])"
    223           (p "Destructively remove any keywords & keyword+value items from a "
    224           (code "#!rest") " argument list.")
    225 
    226           (p "When the optional predicate is supplied it must return "
    227           (code "#t") " or " (code "#f") " indicating whether the item "
    228           "is to kept or removed. The predicate takes the current item.")
    229 
    230           (p "When the optional keyword list is supplied only keywords & "
    231           "keyword+value items from the list are removed."))
    232 
    233         (procedure "(alist-inverse-ref VALUE ALIST [EQUALITY? eqv?] [DEFAULT #f])"
    234           (p "Returns the first key associated with " (tt "VALUE") " in "
    235           "the " (tt "ALIST") " using the " (tt "EQUALITY?") " predicate, "
    236           "else " (tt "DEFAULT") "."))
    237 
    238         (procedure "(alist-delete* KEY ALIST [COUNT [EQUALITY?]])"
    239           (p "Deletes the first (tt "COUNT") associations from alist "
    240           (tt "ALIST") "with the given key " (tt "KEY") ", using key-comparison "
    241           "procedure " (tt "EQUALITY?") ". The dynamic order in which the "
    242           "various applications of equality are made is from the alist "
    243           "head to the tail.")
    244 
    245           (p "Returns a new alist. The alist is not disordered - elements that appear "
    246           "in the result alist occur in the same order as they occur in "
    247           "the argument alist.")
    248 
    249           (p "The equality procedure is used to compare the element "
    250           "keys, 'key[i: 0 <= i < (length ALIST)]', of the alist's "
    251           "entries to the key parameter in this way: '(EQUALITY? KEY "
    252           "key[i])'.")
    253 
    254           (p (tt "COUNT") " defaults to essentially, infinity, and " (tt "EQUALITY?")
    255           " defaults to " (code "equal?") ".") )
    256 
    257         (procedure "(alist-delete-first KEY ALIST [EQUALITY?])"
    258           (p "Returns " (code "(alist-delete* KEY ALIST 1 [EQUALITY?])") ".") )
    259 
    260         (procedure "(unzip-alist ALIST)"
    261           (p "Returns 2 values, a list of the keys & a list of the values from
    262           the " (tt "ALIST") ".") )
    263       )
    264 
    265       (subsection "Arithmetic"
    266 
    267         (usage "(require-extension misc-extn-numeric)")
    268 
    269         (macro "(inc VAL)"
    270           (p "Read-only increment."))
    271 
    272         (macro "(dec VAL)"
    273           (p "Read-only decrement."))
    274 
    275         (macro "(++ VAL)"
    276           (p "Read-only increment."))
    277 
    278         (macro "(-- VAL)"
    279           (p "Read-only decrement."))
    280 
    281         (macro "(fx++ VAL)"
    282           (p "Read-only fixnum increment."))
    283 
    284         (macro "(fx-- VAL)"
    285           (p "Read-only fixnum decrement."))
    286 
    287         (macro "(fp++ VAL)"
    288           (p "Read-only flonum increment."))
    289 
    290         (macro "(fp-- VAL)"
    291           (p "Read-only flonum decrement."))
    292 
    293         (macro "(++! VAR)"
    294           (p "Mutable increment."))
    295 
    296         (macro "(--! VAR)"
    297           (p "Mutable decrement."))
    298 
    299         (macro "(fx++! VAR)"
    300           (p "Mutable fixnum increment."))
    301 
    302         (macro "(fx--! VAR)"
    303           (p "Mutable fixnum decrement."))
    304 
    305         (macro "(fp++! VAR)"
    306           (p "Mutable flonum increment."))
    307 
    308         (macro "(fp--! VAR)"
    309           (p "Mutable flonum decrement."))
    310       )
    311 
    312       (subsection "Posix"
    313 
    314         (usage "(require-extension misc-extn-posix)")
    315 
    316         (procedure "(replace-fileno NEW-FILENO KNOWN-FILENO)"
    317           (p "Replaces the meaning of " (tt "KNOWN-FILENO") " with "
    318           (tt "NEW-FILENO") ". I/O Redirection.") )
    319 
    320         (procedure "(create-directory/parents DIRECTORY)"
    321           (p "Ensures the directory pathname " (tt "DIRECTORY") " exists.")
    322 
    323           (p "Like the UNIX `\"mkdir -p DIRECTORY\" command.") )
    324 
    325         (procedure "(create-pathname-directory PATHNAME)"
    326           (p "Ensures the directory component of " (tt "PATHNAME") " exist.")
    327 
    328           (p "Like the UNIX `\"mkdir -p `dirname PATHNAME`\" command.") )
    329 
    330         (procedure "(make-program-filename COMMAND)"
    331           (p "Returns the platform specific form of an executable command "
    332           "filename.")
    333 
    334           (p "On Windows the " (code "exe") " extension is added unless an "
    335           "extension is already present. Does nothing on other platforms.") )
    336 
    337         (procedure "(file-exists/directory? FILENAME [DIRECTORY | DIRECTORY-LIST])"
    338           (p "Returns the pathname when " (tt "FILENAME") " exists in the "
    339           (tt "DIRECTORY") ", otherwise " (code "#f") ".")
    340 
    341           (p (tt "DIRECTORY-LIST") " is as for " (code "make-pathname") ".")
    342 
    343           (p "When only the " (tt "FILENAME") " parameter supplied then the "
    344           "same as " (code "file-exists?") ".") )
    345 
    346         (procedure "(find-file-pathnames FILENAME [DIRECTORY | DIRECTORY-LIST] ...)"
    347           (p "Returns a list of all pathnames found for " (tt "FILENAME") " in "
    348           "the supplied directory/directories, or " (code "#f") " when not found.")
    349 
    350           (p "The list of pathnames is in the same relative order as that of "
    351           "the directory parameter(s).") )
    352 
    353         (procedure "(find-program-pathnames COMMAND-NAME [DIRECTORY | DIRECTORY-LIST] ...)"
    354           (p "Returns a list of all pathnames found for " (tt "COMMAND-NAME") " in "
    355           "the supplied directory/directories, or " (code "#f") " when not found.")
    356 
    357           (p "Uses " (code "make-program-filename") " to make a filename.")
    358 
    359           (p "Does not ensure that the file is executable!") )
    360 
    361         (procedure "(which-command-pathname COMMAND-NAME [ENVIRONMENT-VARIABLE "PATH"])"
    362           (p "Returns the first directory in the " (tt "ENVIRONMENT-VARIABLE") " "
    363           "where a file named " (tt "COMMAND-NAME") " exists, "
    364           "or " (code "#f") " when nothing found.")
    365 
    366           (p "Uses the platform specific PATH environment variable element "
    367           "separator - a semi-colon for Windows, & a colon otherwise.")
    368 
    369           (p "Like the UNIX \"which COMMAND-NAME\" command.") )
    370 
    371         (procedure "(remove-dotfiles FILES)"
    372           (p "Remove dot files from a directory list. Useful with " (code "glob") "."))
    373 
    374                                 (subsubsection "Scheduling Priority"
    375 
    376           (p "Parameter Descriptions")
    377           (symbol-table
    378             (describe priority/process
    379               "Process WHICH - WHO is 0 for current process or a process identifier.")
    380             (describe priority/process-group
    381               "Process Group WHICH - WHO is 0 for current process group or a process group identifier.")
    382             (describe priority/user
    383               "User WHICH - WHO is 0 for current user or a user identifier.")
    384             (describe PRIORITY
    385               "An integer [-20 20].") )
    386           (br)
    387 
    388           (procedure "(scheduling-priority WHICH WHO)"
    389             (p "Returns the priority of " (tt "WHO") " of kind " (tt "WHICH") ".") )
    390 
    391           (procedure "(set-scheduling-priority! WHICH WHO PRIORITY)"
    392             (p "Sets the priority of " (tt "WHO") " of kind " (tt "WHICH") " to "
    393             (tt "PRIORITY") ".") )
    394         )
    395 
    396                                 (subsubsection "Pseudo-TTY"
    397 
    398           (p "Currently a thin wrapper around the C interface. Scheme bindings "
    399           "for the necessary C constants are not provided.")
    400 
    401           (procedure "(alloc-winsize)"
    402             (p "Returns the pointer to a new C struct winsize.") )
    403 
    404           (procedure "(free-winsize (nonnull-pointer WINSIZE))"
    405             (p "Releases a C struct winsize.") )
    406 
    407           (p "Accessors for a struct winsize")
    408           (symbol-table
    409             (describe winsize-col "Returns ws_col")
    410             (describe winsize-col-set! "Sets ws_col")
    411             (describe winsize-row "Returns ws_row")
    412             (describe winsize-row-set! "Sets ws_row")
    413             (describe winsize-xpixel "Returns ws_xpixel")
    414             (describe winsize-xpixel-set! "Sets ws_xpixel")
    415             (describe winsize-ypixel "Returns ws_ypixel")
    416             (describe winsize-ypixel-set! "Sets ws_ypixel") )
    417           (br)
    418 
    419           (procedure "(alloc-termios)"
    420             (p "Returns the pointer to a new C struct termios.") )
    421 
    422           (procedure "(free-termios (nonnull-pointer TERMIOS))"
    423             (p "Releases a C struct termios.") )
    424 
    425           (p "Accessors for a struct termios")
    426           (symbol-table
    427             (describe termios-cc "Returns c_cc[idx]")
    428             (describe termios-cc-set! "Sets c_cc[idx]")
    429             (describe termios-cflag "Returns c_cflag")
    430             (describe termios-cflag-set! "Sets c_cflag")
    431             (describe termios-iflag "Returns c_iflag")
    432             (describe termios-iflag-set! "Sets c_iflag")
    433             (describe termios-lflag "Returns c_lflag")
    434             (describe termios-lflag-set! "Sets c_lflag")
    435             (describe termios-oflag "Returns c_oflag")
    436             (describe termios-oflag-set! "Sets c_oflag")
    437             (describe termios-ispeed "Returns c_ispeed")
    438             (describe termios-ispeed-set! "Sets c_ispeed")
    439             (describe termios-ospeed "Returns c_ospeed")
    440             (describe termios-ospeed-set! "Sets c_ospeed") )
    441           (br)
    442 
    443           (procedure "(login-tty SLAVE-FILENO)"
    444             (p "The C procedure.") )
    445 
    446           (procedure "(open-pty (nonnull-pointer MASTER-FILENO) (nonnull-pointer SLAVE-FILENO) (c-string NAME) (pointer WINSIZE) (pointer TERMIOS))"
    447             (p "The C procedure.") )
    448         )
    449       )
    450 
    451       (subsection "Symbol"
    452 
    453         (usage "(require-extension misc-extn-symbol)")
    454 
    455         (macro "(unbound-value)"
    456           (p "Returns the value representing \"unbound\".") )
    457 
    458         (macro "(unbound-value? OBJECT)"
    459           (p "Is the " (tt "OBJECT") " the unbound value?") )
    460 
    461         (macro "(unbound? SYMBOL)"
    462           (p "Is the " (tt "SYMBOL") " unbound?")
    463 
    464           (p (tt "SYMBOL") " is " (b "not") " treated as a literal, be "
    465           "sure to quote if a literal desired.") )
    466 
    467         (macro "(symbol-value SYMBOL [DEFAULT #f])"
    468           (p "Returns the " (tt "SYMBOL") " binding when bound, "
    469           "otherwise the " (tt "DEFAULT") ".")
    470 
    471           (p (tt "SYMBOL") " is " (b "not") " treated as a literal, be "
    472           "sure to quote if a literal desired.") )
    473 
    474         (macro "(undefined-value)"
    475           (p "Returns the value representing \"undefined\".") )
    476 
    477         (macro "(undefined-value? OBJECT)"
    478           (p "Is the " (tt "OBJECT") " the undefined value?") )
    479 
    480         (macro "(undefined? OBJECT)"
    481           (p "Is the " (tt "OBJECT") " the undefined value?") )
    482 
    483         (procedure "(make-qualified-symbol NAMESPACE SYMBOL)"
    484           (p "Returns the Chicken namespace qualified " (tt "SYMBOL") " for the "
    485           (tt "NAMESPACE") ".")
    486 
    487           (p "An exception is generated when the " (tt "NAMESPACE") " "
    488           "length exceeds the system limit.") )
    489 
    490         (procedure "(make-qualified-uninterned-symbol NAMESPACE SYMBOL)"
    491           (p "Returns the Chicken namespace qualified " (tt "SYMBOL") " for the "
    492           (tt "NAMESPACE") ".") )
    493 
    494         (procedure "(qualified-symbol? SYMBOL)"
    495           (p "Is the " (tt "SYMBOL") " a Chicken namespace qualified symbol."))
    496 
    497         (procedure "(symbol->qualified-string SYMBOL)"
    498           (p "Returns the printname of a Chicken namespace qualified " (tt "SYMBOL") "."))
    499 
    500         (procedure "(interned-symbol? SYMBOL)"
    501           (p "Is the " (tt "SYMBOL") " interned?"))
    502       )
    503 
    504       (subsection "Conditions"
    505 
    506         (usage "(require-extension misc-extn-condition)")
    507 
    508         (p "The build condition API macros are currently " (b "unavailable") " when using "
    509         (b "hygienic") " macros.")
    510 
    511         (macro "(build-condition-naming-API FORM ...)"
    512           (p "Expands into one or more macros that expand into a condition specification "
    513           "form, suitable for use with " (code "build-property-condition-API") " and "
    514           (code "build-composite-condition-API") ".")
    515 
    516           (p "Example: "
    517           (code "(build-condition-naming (exn location message arguments) foo (bar rope))"))
    518 
    519           (p "Creates the following:")
    520 
    521           (ul
    522             (li (code "(define-macro (exn-condition) '(exn location message arguments))") )
    523             (li (code "(define-macro (foo-condition) 'foo)") )
    524             (li (code "(define-macro (bar-condition) '(bar rope))") ) ) )
    525 
    526         (macro "(build-property-condition-API FORM ...)"
    527           (p "Expands into a suite of procedures to construct and test SRFI-12 property "
    528           "condition objects.")
    529 
    530           (p "When only one " (tt "FORM") " is supplied a single property condition API is "
    531           "built. When more than one " (tt "FORM") " are supplied then all the property "
    532           "condition APIs are built.")
    533 
    534           (p "When " (tt "FORM") " is a symbol it is a condition " (tt "KIND-KEY") " and "
    535           "identifies a condition without properties. When " (tt "FORM") " is a list the first "
    536           "element is the condition " (tt "KIND-KEY") " and the following elements are property "
    537           "keys.")
    538 
    539           (p "A condition constructor is named as " (tt "make-KIND-KEY-condition") " "
    540           "and has 0 or more formal parameters, which are the property keys.")
    541 
    542           (p "A condition predicate is named as " (tt "KIND-KEY-condition?") " "
    543           "and has 1 formal parameter, the object to test.")
    544 
    545           (p "Property condition constructors without properties always return the same "
    546           "condition object!")
    547 
    548           (p "Example: "
    549           (code "(build-property-condition-API (exn location message arguments) foo (bar rope))"))
    550 
    551           (p "Creates the following:")
    552 
    553           (ul
    554             (li (code "(make-exn-condition location message arguments)"))
    555             (li (code "(exn-condition? object)") )
    556             (li (code "(make-foo-condition)") )
    557             (li (code "(foo-condition? object)") )
    558             (li (code "(make-bar-condition rope)") )
    559             (li (code "(bar-condition? object)") ) ) )
    560 
    561         (macro "(build-composite-condition-API FORM ...)"
    562           (p "Expands into a suite of procedures to construct and test SRFI-12 a composite "
    563           "condition object.")
    564 
    565           (p (tt "FORM") " is the same as " (tt "FORM") " in the "
    566           (code "build-property-condition-API") " definition.")
    567 
    568           (p "When zero or one " (tt "FORM") " are supplied nothing is built. When more than "
    569           "one " (tt "FORM") " are supplied then a composite API is built.")
    570 
    571           (p "A composite condition constructor is like a property condition constructor, "
    572            "except that the " (tt "KIND-KEY") " is a concatenation of every condition "
    573            (tt "KEY") ", interspersed with a hyphen.")
    574 
    575           (p "A composite condition predicate is like a property condition predicate, "
    576            "except that the " (tt "KIND-KEY") " is a concatenation of every condition "
    577            (tt "KEY") ", interspersed with a hyphen.")
    578 
    579           (p "Example: "
    580           (code "(build-composite-condition-API (exn location message arguments) foo (bar rope))"))
    581 
    582           (p "Creates the following:")
    583 
    584           (ul
    585             (li (code "(make-exn-foo-bar-condition location message arguments rope)") )
    586             (li (code "(exn-foo-bar-condition? object)") ) ) )
    587 
    588         (procedure "(handle-condition THUNK [HANDLER identity])"
    589           (p "Simplified " (code "with-exception-handler") " where the "
    590           (tt "HANDLER") " result is always returned to the caller.")
    591 
    592           (p (tt "HANDLER") " is (-> condition object).") )
    593 
    594         (procedure "(composite-condition? OBJECT [KIND-KEY ...])"
    595           (p "Is the " (tt "OBJECT") " a SRFI-12 composite condition?")
    596 
    597           (p "When one or more " (tt "KIND-KEY") " are supplied then the composite condition "
    598           "must compose at least those kind keys.") )
    599 
    600         (procedure "(condition-kind-keys CONDITION)"
    601           (p "Returns a list of the kind-keys of the SRFI-12 "
    602           (tt "CONDITION") ".") )
    603 
    604         (procedure "(condition-property-keys CONDITION [KIND-KEY])"
    605           (p "Returns a list of the property-keys for " (tt "KIND-KEY") " "
    606           "of the SRFI-12 " (tt "CONDITION") ", or " (code "#f") " when no "
    607           "property keys or the " (tt "CONDITION") " is not of the kind "
    608           (tt "KIND-KEY") ".")
    609 
    610           (p "When " (tt "KIND-KEY") " is missing some kind-key of the "
    611           (tt "CONDITION") " is used.") )
    612 
    613         (procedure "(condition-properties CONDITION [KIND-KEY])"
    614           (p "Returns an association list of the property keys & values "
    615           "for " (tt "KIND-KEY") " of the SRFI-12 " (tt "CONDITION")
    616           ", or " (code "#f") " when no " "property keys or the "
    617           (tt "CONDITION") " is not of the kind " (tt "KIND-KEY") ".")
    618 
    619           (p "When " (tt "KIND-KEY") " is missing some kind-key of the "
    620           (tt "CONDITION") " is used.") )
    621 
    622         (procedure "(condition-explode CONDITION)"
    623           (p "Returns an association list of every kind-key of the "
    624           "SRFI-12 " (tt "CONDITION") ". The value of each entry is the "
    625           "result of " (code "(condition-properties CONDITION KIND-KEY") " "
    626           "for that " (tt "KIND-KEY") ".") )
    627 
    628         (procedure "(make-property-condition/list KIND-LIST PROPERTY-LIST)"
    629           (p "Returns a new condition.")
    630 
    631           (p (tt "KIND-LIST") " is a list of kind-key.")
    632 
    633           (p (tt "PROPERTY-LIST") " is a property list, where the key "
    634           "element is a pair, (<kind-key> . <property-key>).") )
    635       )
    636 
    637       (subsection "Input/Output"
    638 
    639         (usage "(require-extension misc-extn-io)")
    640 
    641         (procedure "(cout EXPR ...)"
    642           (p "Like cout << arguments << args where argument can be any "
    643           "Scheme object. If it's a procedure (without args) it's "
    644           "executed rather than printed (like newline)."))
    645 
    646         (procedure "(cerr EXPR ...)"
    647           (p "Like cerr << arguments << args where argument can be any "
    648           "Scheme object. If it's a procedure (without args) it's "
    649           "executed rather than printed (like newline)."))
    650 
    651         (constant "nl"
    652           (p "String form of the newline character."))
    653       )
    654      )
    655 
    656     (section "Contributions"
    657 
    658       (p "William Annis - hash-let.")
    659 
    660       (p "Oleg Kiselyov's Standard Scheme \"Prelude\" - ++, ...")
    661     )
    662 
    663     (examples ,examples)
    664 
    665734    (section "License" (pre ,license))
    666735  )
  • misc-extn/trunk/misc-extn-list-support.scm

    r5437 r6200  
    1414      ensure-list
    1515      not-null?
    16       alist-inverse-ref alist-delete* alist-delete-first unzip-alist
    17       filter-rest-argument!) ) )
     16      alist-inverse-ref
     17      alist-delete/count alist-delete!/count
     18      alist-delete-first alist-delete-first!
     19      unzip-alist zip-alist
     20      filter-rest-argument!
     21      fixup-extended-lambda-list-rest
     22      fixup-extended-lambda-list-optional
     23      fixup-extended-lambda-list
     24      ; Deprecated
     25      alist-delete*) ) )
     26
     27;;;
     28
     29(define (check-procedure obj loc)
     30  (unless (procedure? obj)
     31    (error loc "invalid procedure" obj)) )
     32
     33(define (check-integer obj loc)
     34  (unless (integer? obj)
     35    (error loc "invalid integer" obj)) )
    1836
    1937;;;
     
    2644
    2745(define (length=1? lst)
    28   (and (pair? lst) (null? (cdr lst))) )
     46  (= 1 (length lst)) )
    2947
    3048;; List of length = 2?
    3149
    3250(define (length=2? lst)
    33   (and (pair? lst) (pair? (cdr lst)) (null? (cddr lst))) )
     51  (= 2 (length lst)) )
    3452
    3553;; List of length > 1?
    3654
    3755(define (length>1? lst)
    38   (and (pair? lst) (pair? (cdr lst))) )
     56  (< 1 (length lst)) )
    3957
    4058;; Returns a list
     
    5977          (let ([key? #f])
    6078            (lambda (arg)
    61               (cond
    62                 [key?
    63                   (set! key? #f)
    64                   #f]
    65                 [(keyword? arg)
    66                   (or (not (itmtst arg testarg)) (begin (set! key? #t) #f))]
    67                 [else
    68                   #t]))))]
     79              (cond [key?
     80                      (set! key? #f)
     81                      #f]
     82                    [(keyword? arg)
     83                      (or (not (itmtst arg testarg)) (begin (set! key? #t) #f))]
     84                    [else
     85                      #t]))))]
    6986      [pred
    70         (cond
    71           [(procedure? testarg)   testarg]
    72           [(list? testarg)        (make-pred memq)]
    73           [(not testarg)          (make-pred (lambda (arg lst) #t))]
    74           [else
    75             (error 'filter-rest-argument!
    76               "test argument not a procedure or list" testarg)])])
     87        (cond [(procedure? testarg)   testarg]
     88              [(list? testarg)        (make-pred memq)]
     89              [(not testarg)          (make-pred (lambda (arg lst) #t))]
     90              [else
     91                (error 'filter-rest-argument!
     92                  "test argument not a procedure or list" testarg)])])
    7793    (filter! pred args) ) )
     94
     95;; Remove any keywords & keyword-value pairs from a #!rest argument.
     96
     97(define (fixup-extended-lambda-list-rest keys rest #!optional (skip? #f))
     98  (let loop ([rest rest] [skip? skip?] [lst '()])
     99    (if (null? rest)
     100        (reverse! lst)
     101        (let ([arg (car rest)]
     102              [nxt (cdr rest)])
     103          (cond [skip?            (loop nxt #f lst)]
     104                [(memq arg keys)  (loop nxt #t lst)]
     105                [else             (loop nxt #f (cons arg lst))]) ) ) ) )
     106
     107;; Remove any keyword from #!optional argument.
     108
     109(define (fixup-extended-lambda-list-optional keys . opts)
     110  (let loop ([opts opts] [skip? #f] [lst '()])
     111    (if (null? opts)
     112        (values skip? (reverse! lst))
     113        (let ([opt (car opts)]
     114              [nxt (cdr opts)])
     115          (let ([val (car opt)]
     116                [def (cadr opt)])
     117            (cond [skip?            (loop nxt #f (cons def lst))]
     118                  [(memq val keys)  (loop nxt #t (cons def lst))]
     119                  [else             (loop nxt #f (cons val lst))]) ) ) ) ) )
     120
     121;; Remove any keywords & keyword-value pairs from a #!rest argument.
     122
     123(define (fixup-extended-lambda-list keys rest . opts)
     124  (let-values ([(skip? fixed-opts) (apply fixup-extended-lambda-list-optional keys opts)])
     125    (apply values (fixup-extended-lambda-list-rest keys rest skip?) fixed-opts) ) )
    78126
    79127;; Search the alist from back to front.
     
    81129(define (alist-inverse-ref val alist #!optional (cmp eqv?) default)
    82130  (let ([cell (rassoc val alist cmp)])
    83     (or (and cell (car cell)) default)))
     131    (if cell (car cell) default) ) )
    84132
    85 ;; Remove 1st N matching elements from the alist
     133;; Remove 1st N matching elements from the alist [functional]
     134
     135(define (alist-delete/count key al #!optional (cmp eqv?) (cnt 1073741823))
     136  (check-procedure cmp 'alist-delete/count)
     137  (check-integer cnt 'alist-delete/count)
     138  (let loop ([cal al] [cnt cnt] [oal '()])
     139    (cond [(null? cal)
     140            (reverse! oal)]
     141          [(pair? cal)
     142            (let ([elm (car cal)]
     143                  [nxt (cdr cal)])
     144              (if (pair? elm)
     145                  (if (positive? cnt)
     146                      ; then more deletion to attempt
     147                      (if (cmp key (car elm))
     148                          (loop nxt (sub1 cnt) oal)
     149                          (loop nxt cnt (cons elm oal)))
     150                      ; else copy rest of spine
     151                      (loop nxt 0 (cons elm oal)))
     152                  (error 'alist-delete/count "invalid association list item" elm)))]
     153          [else
     154            (error 'alist-delete/count "invalid association list" al)]) ) )
    86155
    87156(define (alist-delete* key al #!optional (cnt 1073741823) (cmp equal?))
    88   (unless (procedure? cmp)
    89     (error 'alist-delete* "compare must be a procedure" cmp))
    90   (unless (integer? cnt)
    91     (error 'alist-delete* "count must be an integer" cnt))
    92   (let loop ([al al] [cnt cnt] [oal '()])
    93     (cond
    94       [(null? al)
    95         (reverse! oal)]
    96       [(pair? al)
    97         (let ([elm (car al)]
    98               [nxt (cdr al)])
    99           (if (pair? elm)
    100             (if (positive? cnt)
    101               (if (cmp key (car elm))
    102                 (loop nxt (sub1 cnt) oal)
    103                 (loop nxt cnt (cons elm oal)))
    104               (loop nxt 0 (cons elm oal)))
    105             (error 'alist-delete* "improper association list item" elm)))]
    106       [else
    107         (error 'alist-delete* "improper association list" al)]) ) )
     157  (alist-delete/count key al cmp cnt) )
    108158
    109 ;; Remove 1st matching elements from the alist
     159;; Remove 1st N matching elements from the alist [destructive]
    110160
    111 (define (alist-delete-first key al #!optional (cmp equal?))
    112   (alist-delete* key al 1 cmp) )
     161(define (alist-delete!/count key al #!optional (cmp eqv?) (cnt 1073741823))
     162  (check-procedure cmp 'alist-delete!/count)
     163  (check-integer cnt 'alist-delete!/count)
     164  (let ([ral al])
     165    (let loop ([cal al] [pal #f] [cnt cnt])
     166      (cond [(or (null? cal) (not (positive? cnt)))
     167              ral]
     168            [(pair? cal)
     169              (let ([elm (car cal)]
     170                    [nxt (cdr cal)])
     171                (if (pair? elm)
     172                    (cond [(cmp key (car elm))
     173                            (if pal
     174                                (set-cdr! pal nxt)
     175                                (set! ral nxt))
     176                              (loop nxt pal (sub1 cnt))]
     177                           [else
     178                              (loop nxt cal cnt)])
     179                    (error 'alist-delete!/count "invalid association list item" elm)))]
     180            [else
     181              (error 'alist-delete!/count "invalid association list" al)]) ) ) )
     182
     183;; Remove 1st matching elements from the alist [functional]
     184
     185(define (alist-delete-first key al #!optional (cmp eqv?))
     186  (alist-delete/count key al cmp 1) )
     187
     188;; Remove 1st matching elements from the alist [destructive]
     189
     190(define (alist-delete-first! key al #!optional (cmp eqv?))
     191  (alist-delete!/count key al cmp 1) )
    113192
    114193;; Split alist into keys list & values list
    115194
    116 (define (unzip-alist alist)
    117   (let loop ([alist alist] [keys '()] [vals '()])
    118     (if (null? alist)
    119       (values (reverse! keys) (reverse! vals))
    120       (let ([elm (car alist)])
    121         (if (pair? elm)
    122           (loop (cdr alist) (cons (car elm) keys) (cons (cdr elm) vals))
    123           (error 'unzip-alist "improper assocication list" elm)) ) ) ) )
     195(define unzip-alist unzip2)
     196(define zip-alist zip)
  • misc-extn/trunk/misc-extn-list.scm

    r5437 r6200  
    44;;; Lists
    55
     6;; List of length = 0?
     7
     8(define-macro (length=0? ?lst)
     9  `(null?,?lst) )
     10
     11;; List of length = 1?
     12
     13(define-macro (length=1? ?lst)
     14  `(= 1 (length ,?lst)) )
     15
     16;; List of length = 2?
     17
     18(define-macro (length=2? ?lst)
     19  `(= 2 (length ,?lst)) )
     20
     21;; List of length > 1?
     22
     23(define-macro (length>1? ?lst)
     24  `(< 1 (length ,?lst)) )
     25
     26;; Returns a list
     27
     28(define-macro (ensure-list ?obj)
     29  (let ([objvar (gensym)])
     30    `(let ([,objvar ,?obj])
     31       (if (list? ,objvar) ,objvar (list ,objvar)) ) ) )
     32
     33;; Returns #f if given list is empty and the list itself otherwise
     34;; It is intended for emulation of MIT-style empty list treatment
     35;; (not-null? <list>) may be considered as a counterpart to MIT-style <list>
     36
     37(define-macro (not-null? ?lst)
     38  (let ([lstvar (gensym)])
     39    `(let ([,lstvar ,?lst])
     40       (and (not (null? ,lstvar))
     41            ,lstvar) ) ) )
     42
    643;; shift! with a variable
    744
    8 (define-macro (shift!/set SYM . REST)
    9   (let ([DEF (if (pair? REST) (car REST) #f)]
    10         [VAR (gensym)])
    11     `(if (pair? ,SYM)
    12        (let ([,VAR (car ,SYM)])
    13          (set! ,SYM (cdr ,SYM))
    14          ,VAR )
    15        ,DEF ) ) )
     45(define-macro (shift!/set ?var . ?rest)
     46  (let-optionals ?rest ([?empval #f])
     47    (let ([tmpvar (gensym)])
     48      `(if (pair? ,?var)
     49           (let ([,tmpvar (car ,?var)])
     50             (set! ,?var (cdr ,?var))
     51             ,tmpvar )
     52           ,?empval ) ) ) )
    1653
    1754;; Some useful alist search macros. Supplied default maybe a thunk or other.
     
    2360  (let ([test
    2461          (if (length>1? opt-args)
    25             (let ([testp (car opt-args)])
    26               (set! opt-args (cdr opt-args))
    27               testp)
    28             `equal?)])
     62              (let ([testp (car opt-args)])
     63                (set! opt-args (cdr opt-args))
     64                testp)
     65              `equal?)])
    2966    (let ([default-action
    3067            (if (pair? opt-args)
    31               (let ([defact-symb (car opt-args)])
    32                 `(if (procedure? ,defact-symb) (,defact-symb) ,defact-symb))
    33               `(error 'assoc-def "key not found" ,key))])
     68                (let ([defact-symb (car opt-args)])
     69                  `(if (procedure? ,defact-symb) (,defact-symb) ,defact-symb))
     70                `(error 'assoc-def "key not found" ,key))])
    3471      `(or (assoc ,key ,alist ,test) ,default-action))))
    3572
     
    3976  (let ([default-action
    4077          (if (pair? opt-args)
    41             (let ([defact-symb (car opt-args)])
    42               `(if (procedure? ,defact-symb) (,defact-symb) ,defact-symb))
    43             `(error 'assq-def "key not found" ,key))])
    44     `(or (assq ,key ,alist) ,default-action)))
     78              (let ([defact-symb (car opt-args)])
     79                `(if (procedure? ,defact-symb) (,defact-symb) ,defact-symb))
     80              `(error 'assq-def "key not found" ,key))])
     81    `(or (assq ,key ,alist) ,default-action) ) )
    4582
    4683;; opt-args may be () or (def)
     
    4986  (let ([default-action
    5087          (if (pair? opt-args)
    51             (let ([defact-symb (car opt-args)])
    52               `(if (procedure? ,defact-symb) (,defact-symb) ,defact-symb))
    53             `(error 'assv-def "key not found" ,key))])
    54     `(or (assv ,key ,alist) ,default-action)))
     88              (let ([defact-symb (car opt-args)])
     89                `(if (procedure? ,defact-symb) (,defact-symb) ,defact-symb))
     90              `(error 'assv-def "key not found" ,key))])
     91    `(or (assv ,key ,alist) ,default-action) ) )
     92
     93;; Remove 1st matching elements from the alist [functional]
     94
     95(define-macro (alist-delete-first ?key ?al . ?rest)
     96  (let-optionals ?rest ([?cmp 'eqv?])
     97    `(alist-delete/count ,?key ,?al ,?cmp 1) ) )
     98
     99;; Remove 1st matching elements from the alist [destructive]
     100
     101(define-macro (alist-delete-first! ?key ?al . ?rest)
     102  (let-optionals ?rest ([?cmp 'eqv?])
     103    `(alist-delete!/count ,?key ,?al ,?cmp 1) ) )
     104
     105;;
     106
     107(define-macro (dsssl-fixup ?keys ?opts ?rest . ?body)
     108  (let-values (
     109      [(optvars optvals)
     110        (let loop ([opts ?opts]
     111                   [varlst '()]
     112                   [vallst '()])
     113          (if (null? opts)
     114              (values (reverse varlst) (reverse vallst))
     115              (let* ([opt (car opts)]
     116                     [var (car opt)])
     117                (loop (cdr opts)
     118                      (cons var varlst)
     119                      (cons `(list ,var ,(cadr opt)) vallst)))))])
     120    `(let-values ([(,?rest ,@optvars) (fixup-extended-lambda-list ,?keys ,?rest ,@optvals)])
     121       ,@?body ) ) )
  • misc-extn/trunk/misc-extn.html

    r5702 r6200  
    156156<h3>Author</h3><a href="mailto:klovett@pacbell.net">Kon Lovett</a></div>
    157157<div class="section">
     158<h3>Download</h3><a href="misc-extn.egg">misc-extn.egg</a></div>
     159<div class="section">
     160<h3>Documentation</h3>
     161<div class="subsection">
     162<h4>Record Types</h4>
     163<div class="section">
     164<h3>Usage</h3>(require-extension misc-extn-record)</div>
     165<dt class="definition"><strong>macro:</strong> (define-unchecked-record-type T CTOR PRED [SLOT ...])</dt>
     166<dd>
     167<p>SRFI-9 '(define-record-type T CTOR PRED [SLOT ...])', except no checks are made for correct record type before slot access, and the record type symbol is not defined.</p>
     168<p>For use when slot access is attempted <i>only</i> after determining the correct record type explicitly. Do <i>not</i> make constructed slot access procedures part of a public API.</p></dd>
     169<dt class="definition"><strong>macro:</strong> (define-inline-unchecked-record-type T CTOR PRED [SLOT ...])</dt>
     170<dd>
     171<p>SRFI-9 '(define-record-type T CTOR PRED [SLOT ...])', except no checks are made for correct record type before slot access, the record type symbol is not defined, and  procedures are inline.</p>
     172<p>For use when slot access is attempted <i>only</i> after determining the correct record type explicitly.</p></dd></div>
     173<div class="subsection">
     174<h4>Control Forms</h4>
     175<div class="section">
     176<h3>Usage</h3>(require-extension misc-extn-control)</div>
     177<dt class="definition"><strong>macro:</strong> (typecase EXPRESSION [(TYPE-TEST BODY ...) ...])</dt>
     178<dd>
     179<p>Expands into a <code>cond</code> form where every case test is a type test.</p>
     180<p>A <tt>TYPE-TEST</tt> is either a symbol, which must be the base symbol of a type predicate, a non-null list, which must be a list of the base symbols of type predicates, or the symbol <code>else</code>. An example of a base symbol of a type predicate is <code>symbol</code> and the procedure <code>(symbol? OBJECT)</code> is used for the test.</p>
     181<p>The <tt>BODY</tt> is not processed. It must be legal as the body of a <code>cond</code> case.</p></dd>
     182<dt class="definition"><strong>macro:</strong> (typecase* EXPRESSION [(TYPE-TEST BODY ...) ...])</dt>
     183<dd>
     184<p>Like <code>typecase</code> but binds local variable <code>it</code> to the value of <tt>EXPRESSION</tt>.</p></dd>
     185<dt class="definition"><strong>macro:</strong> (whennot TEST [BODY ...])</dt>
     186<dd>
     187<p>Synonym for <code>unless</code>.</p></dd>
     188<dt class="definition"><strong>macro:</strong> (swap-set! VAR1 VAR2)</dt>
     189<dd>
     190<p>Swap settings of <tt>VAR1</tt> &amp; <tt>VAR2</tt>.</p></dd>
     191<dt class="definition"><strong>macro:</strong> (fluid-set! VAR VAL ...)</dt>
     192<dd>
     193<p>Set each variable <tt>VAR</tt> to the value <tt>VAL</tt> in parallel.</p></dd>
     194<dt class="definition"><strong>macro:</strong> (stiff-set! VAR VAL ...)</dt>
     195<dd>
     196<p>Set each variable <tt>VAR</tt> to the value <tt>VAL</tt> in series.</p></dd>
     197<dt class="definition"><strong>macro:</strong> (hash-let (([VAR | (VAR KEY)] ...) HASH-TABLE) BODY ...)</dt>
     198<dd>
     199<p>Decompose <tt>HASH-TABLE</tt> entries into variable bindings. Should the <tt>KEY</tt> not be symbol, or the desired variable name <tt>VAR</tt> should not be the key, the '(VAR KEY)' form can be used. The <tt>BODY ...</tt> is evaluated with the specified bindings.</p></dd>
     200<dt class="definition"><strong>macro:</strong> (set!/op VAR OP ARG ...)</dt>
     201<dd>
     202<p>Sets <tt>VAR</tt> to the value of <code>(OP ARG ...)</code>, where the first occurrence of <code>&lt;&gt;</code> in <tt>ARG ...</tt> is replaced with <tt>VAR</tt>.</p>
     203<p>When there is no occurrence of <code>&lt;&gt;</code> in <tt>ARG ...</tt>the template <tt>(OP &lt;&gt; ARG ...)</tt> is used.</p></dd>
     204<dt class="definition"><strong>procedure:</strong> (assure EXPRESSION [ERROR-ARGUMENT ...])</dt>
     205<dd>
     206<p>When <tt>EXPRESSION</tt> yields <code>#f</code> invoke <code>(error ERROR-ARGUMENT ...)</code>, otherwise return value.</p></dd>
     207<dt class="definition"><strong>procedure:</strong> (identify-error [CALLER] MSG ARGS ...)</dt>
     208<dd>
     209<p>Prints a message like <tt>(error ...)</tt> to <tt>(current-error-port)</tt> but does not throw an exception.</p></dd>
     210<dt class="definition"><strong>procedure:</strong> (errorf [ID] [FORMAT-STRING ARGS ...])</dt>
     211<dd>
     212<p>Same as '(error [ID] (sprintf FORMAT-STRING ARGS ...))'.</p>
     213<p>The actual argument for the returned procedure is to be a procedure which will be applied with the evaluated expressions as the actual argument list.</p></dd></div>
     214<div class="subsection">
     215<h4>Lists</h4>
     216<div class="section">
     217<h3>Usage</h3>(require-extension misc-extn-list)</div>
     218<p>The following macros are also availabe as procedures.</p>
     219<dt class="definition"><strong>macro:</strong> (length=0? LIST)</dt>
     220<dd>
     221<p>List of length zero?</p></dd>
     222<dt class="definition"><strong>macro:</strong> (length=1? LIST)</dt>
     223<dd>
     224<p>List of length one?</p></dd>
     225<dt class="definition"><strong>macro:</strong> (length=2? LIST)</dt>
     226<dd>
     227<p>List of length two?</p></dd>
     228<dt class="definition"><strong>macro:</strong> (length&gt;1? LIST)</dt>
     229<dd>
     230<p>List of length greater than one?</p></dd>
     231<dt class="definition"><strong>macro:</strong> (shift!/set VARIABLE [WHEN-EMPTY])</dt>
     232<dd>
     233<p>Like <code>shift!</code> in the utils unit but assigns the <tt>VARIABLE</tt> <code>'()</code> after shifting from a list of length 1.</p>
     234<p><tt>WHEN-EMPTY</tt>, which defaults to <code>#f</code> is returned when the list bound to <tt>VARIABLE</tt> is empty.</p></dd>
     235<dt class="definition"><strong>macro:</strong> (ensure-list OBJECT)</dt>
     236<dd>
     237<p>Returns a list, either the list <tt>OBJECT</tt> or <code>(list OBJECT)</code>.</p></dd>
     238<dt class="definition"><strong>macro:</strong> (not-null? LIST)</dt>
     239<dd>
     240<p>Returns <code>#f</code> if the given <tt>LIST</tt> is empty, and <tt>LIST</tt> otherwise.</p></dd></div>
     241<div class="subsection">
     242<h4>Association Lists</h4>
     243<div class="section">
     244<h3>Usage</h3>(require-extension misc-extn-list)</div>
     245<dt class="definition"><strong>procedure:</strong> (alist-inverse-ref VALUE ALIST [TEST? [NOT-FOUND]])</dt>
     246<dd>
     247<p>Returns the first key associated with <tt>VALUE</tt> in the <tt>ALIST</tt> using the <tt>TEST?</tt> predicate, else <tt>NOT-FOUND</tt>.</p>
     248<p><tt>TEST?</tt> is <code>eqv?</code> and <tt>NOT-FOUND</tt> is <code>#f</code>.</p></dd>
     249<dt class="definition"><strong>procedure:</strong> (alist-delete/count KEY ALIST [TEST? [COUNT]])</dt>
     250<dd>
     251<p>Deletes the first (tt COUNT) associations from alist <tt>ALIST</tt>with the given key <tt>KEY</tt>, using key-comparison procedure <tt>TEST?</tt>. The dynamic order in which the various applications of equality are made is from the alist head to the tail.</p>
     252<p>Returns a new alist. The alist is not disordered - elements that appear in the result alist occur in the same order as they occur in the argument alist.</p>
     253<p>The equality procedure is used to compare the element keys, 'key[i: 0 &lt;= i &lt; (length ALIST)]', of the alist's entries to the key parameter in this way: '(TEST? KEY key[i])'.</p>
     254<p><tt>COUNT</tt> defaults to essentially, infinity, and <tt>EQUALITY?</tt> defaults to <code>eqv?</code>.</p></dd>
     255<dt class="definition"><strong>procedure:</strong> (alist-delete!/count KEY ALIST [TEST? [COUNT]])</dt>
     256<dd>
     257<p>Destructive version of <code>alist-delete/count</code>.</p></dd>
     258<p><code>alist-delete-first</code> and <code>alist-delete-first!</code> are also available as procedures.</p>
     259<dt class="definition"><strong>macro:</strong> (alist-delete-first KEY ALIST [TEST?])</dt>
     260<dd>
     261<p>Returns <code>(alist-delete/count KEY ALIST 1 [TEST?])</code>.</p></dd>
     262<dt class="definition"><strong>macro:</strong> (alist-delete-first! KEY ALIST [TEST?])</dt>
     263<dd>
     264<p>Destructive version of <code>alist-delete-first</code>.</p></dd>
     265<dt class="definition"><strong>procedure:</strong> (unzip-alist ALIST)</dt>
     266<dd>
     267<p>Returns 2 values, a list of the keys &amp; a list of the values from
     268          the <tt>ALIST</tt>.</p></dd>
     269<dt class="definition"><strong>procedure:</strong> (zip-alist KEYS VALUES)</dt>
     270<dd>
     271<p>Returns an association list with elements from the corresponding items of <tt>KEYS</tt> and <tt>VALUES</tt>.</p></dd>
     272<p>Error signaling versions of the standard association lookup functions. When the <tt>KEY</tt> is not found and a <tt>NOT-FOUND</tt> value is not supplied an <code>error</code> is invoked.</p>
     273<dt class="definition"><strong>macro:</strong> (assoc-def KEY ALIST [TEST] [NOT-FOUND])</dt>
     274<dd>
     275<p>The assoc procedure with an optional test and default value.</p></dd>
     276<dt class="definition"><strong>macro:</strong> (assv-def KEY ALIST [NOT-FOUND])</dt>
     277<dd>
     278<p>The assv procedure with a default value.</p></dd>
     279<dt class="definition"><strong>macro:</strong> (assq-def KEY ALIST [NOT-FOUND])</dt>
     280<dd>
     281<p>The assq procedure with a default value.</p></dd></div>
     282<div class="subsection">
     283<h4>DSSSL Extended Lambda List</h4>
     284<div class="section">
     285<h3>Usage</h3>(require-extension misc-extn-dsssl)</div>
     286<dt class="definition"><strong>procedure:</strong> (filter-rest-argument! REST-LIST [PREDICATE | LIST-OF-KEYWORD])</dt>
     287<dd>
     288<p>Destructively remove any keywords &amp; keyword+value items from a <code>#!rest</code> argument list.</p>
     289<p>When the optional predicate is supplied it must return <code>#t</code> or <code>#f</code> indicating whether the item is to kept or removed. The predicate takes the current item.</p>
     290<p>When the optional keyword list is supplied only keywords &amp; keyword+value items from the list are removed.</p></dd>
     291<dt class="definition"><strong>procedure:</strong> (fixup-extended-lambda-list-rest LIST-OF-KEYWORD REST-LIST)</dt>
     292<dd>
     293<p>Returns a list from <tt>REST-LIST</tt> with all key'ed pairs from <tt>LIST-OF-KEYWORD</tt> removed.</p></dd>
     294<dt class="definition"><strong>procedure:</strong> (fixup-extended-lambda-list-optional LIST-OF-KEYWORD OPTIONAL ...)</dt>
     295<dd>
     296<p>Returns N+1 values from <tt>OPTIONAL ...</tt>, where N is the number of optionals, with all key'ed pairs from <tt>LIST-OF-KEYWORD</tt> removed. The first return value is the 'skip?' flag, the remaining are the &quot;fixed&quot; optional values.</p>
     297<p><tt>OPTIONAL</tt> is a list of the form <code>(VALUE DEFAULT)</code>.</p>
     298<p>The optionals run left-to-right, and the key/value pairs are assumed to bind left-to-right.</p></dd>
     299<dt class="definition"><strong>procedure:</strong> (fixup-extended-lambda-list LIST-OF-KEYWORD REST-LIST [OPTIONAL ...])</dt>
     300<dd>
     301<p>Returns N+1 values where the 1st value is the &quot;fixed&quot; <tt>REST-LIST</tt> and the remaining values are the &quot;fixed&quot; <tt>OPTIONAL ...</tt>.</p></dd>
     302<dt class="definition"><strong>macro:</strong> (dsssl-fixup LIST-OF-KEYWORD LIST-OF-OPTIONAL REST-VARIABLE BODY ...)</dt>
     303<dd>
     304<p>Expands the <tt>BODY ...</tt> in a new lexical scope with the optional and rest variables bound to the &quot;fixed&quot; values.</p>
     305<p><tt>LIST-OF-OPTIONAL</tt> is a list of elements of the form <code>(VARIABLE DEFAULT)</code> where <tt>VARIABLE</tt> is the optional variable name and <tt>DEFAULT</tt> is the optional variable default value.</p></dd></div>
     306<div class="subsection">
     307<h4>Arithmetic</h4>
     308<div class="section">
     309<h3>Usage</h3>(require-extension misc-extn-numeric)</div>
     310<dt class="definition"><strong>macro:</strong> (inc VAL)</dt>
     311<dd>
     312<p>Read-only increment.</p></dd>
     313<dt class="definition"><strong>macro:</strong> (dec VAL)</dt>
     314<dd>
     315<p>Read-only decrement.</p></dd>
     316<dt class="definition"><strong>macro:</strong> (++ VAL)</dt>
     317<dd>
     318<p>Read-only increment.</p></dd>
     319<dt class="definition"><strong>macro:</strong> (-- VAL)</dt>
     320<dd>
     321<p>Read-only decrement.</p></dd>
     322<dt class="definition"><strong>macro:</strong> (fx++ VAL)</dt>
     323<dd>
     324<p>Read-only fixnum increment.</p></dd>
     325<dt class="definition"><strong>macro:</strong> (fx-- VAL)</dt>
     326<dd>
     327<p>Read-only fixnum decrement.</p></dd>
     328<dt class="definition"><strong>macro:</strong> (fp++ VAL)</dt>
     329<dd>
     330<p>Read-only flonum increment.</p></dd>
     331<dt class="definition"><strong>macro:</strong> (fp-- VAL)</dt>
     332<dd>
     333<p>Read-only flonum decrement.</p></dd>
     334<dt class="definition"><strong>macro:</strong> (++! VAR)</dt>
     335<dd>
     336<p>Mutable increment.</p></dd>
     337<dt class="definition"><strong>macro:</strong> (--! VAR)</dt>
     338<dd>
     339<p>Mutable decrement.</p></dd>
     340<dt class="definition"><strong>macro:</strong> (fx++! VAR)</dt>
     341<dd>
     342<p>Mutable fixnum increment.</p></dd>
     343<dt class="definition"><strong>macro:</strong> (fx--! VAR)</dt>
     344<dd>
     345<p>Mutable fixnum decrement.</p></dd>
     346<dt class="definition"><strong>macro:</strong> (fp++! VAR)</dt>
     347<dd>
     348<p>Mutable flonum increment.</p></dd>
     349<dt class="definition"><strong>macro:</strong> (fp--! VAR)</dt>
     350<dd>
     351<p>Mutable flonum decrement.</p></dd></div>
     352<div class="subsection">
     353<h4>Posix</h4>
     354<div class="section">
     355<h3>Usage</h3>(require-extension misc-extn-posix)</div>
     356<dt class="definition"><strong>procedure:</strong> (replace-fileno NEW-FILENO KNOWN-FILENO)</dt>
     357<dd>
     358<p>Replaces the meaning of <tt>KNOWN-FILENO</tt> with <tt>NEW-FILENO</tt>. I/O Redirection.</p></dd>
     359<dt class="definition"><strong>procedure:</strong> (create-directory/parents DIRECTORY)</dt>
     360<dd>
     361<p>Ensures the directory pathname <tt>DIRECTORY</tt> exists.</p>
     362<p>Like the UNIX `&quot;mkdir -p DIRECTORY&quot; command.</p></dd>
     363<dt class="definition"><strong>procedure:</strong> (create-pathname-directory PATHNAME)</dt>
     364<dd>
     365<p>Ensures the directory component of <tt>PATHNAME</tt> exist.</p>
     366<p>Like the UNIX `&quot;mkdir -p `dirname PATHNAME`&quot; command.</p></dd>
     367<dt class="definition"><strong>procedure:</strong> (make-program-filename COMMAND)</dt>
     368<dd>
     369<p>Returns the platform specific form of an executable command filename.</p>
     370<p>On Windows the <code>exe</code> extension is added unless an extension is already present. Does nothing on other platforms.</p></dd>
     371<dt class="definition"><strong>procedure:</strong> (file-exists/directory? FILENAME [DIRECTORY | DIRECTORY-LIST])</dt>
     372<dd>
     373<p>Returns the pathname when <tt>FILENAME</tt> exists in the <tt>DIRECTORY</tt>, otherwise <code>#f</code>.</p>
     374<p><tt>DIRECTORY-LIST</tt> is as for <code>make-pathname</code>.</p>
     375<p>When only the <tt>FILENAME</tt> parameter supplied then the same as <code>file-exists?</code>.</p></dd>
     376<dt class="definition"><strong>procedure:</strong> (find-file-pathnames FILENAME [DIRECTORY | DIRECTORY-LIST] ...)</dt>
     377<dd>
     378<p>Returns a list of all pathnames found for <tt>FILENAME</tt> in the supplied directory/directories, or <code>#f</code> when not found.</p>
     379<p>The list of pathnames is in the same relative order as that of the directory parameter(s).</p></dd>
     380<dt class="definition"><strong>procedure:</strong> (find-program-pathnames COMMAND-NAME [DIRECTORY | DIRECTORY-LIST] ...)</dt>
     381<dd>
     382<p>Returns a list of all pathnames found for <tt>COMMAND-NAME</tt> in the supplied directory/directories, or <code>#f</code> when not found.</p>
     383<p>Uses <code>make-program-filename</code> to make a filename.</p>
     384<p>Does not ensure that the file is executable!</p></dd>
     385<dt class="definition"><strong>procedure:</strong> (which-command-pathname COMMAND-NAME [ENVIRONMENT-VARIABLE </dt>
     386<dd>
     387<PATH>])
     388<p>Returns the first directory in the <tt>ENVIRONMENT-VARIABLE</tt> where a file named <tt>COMMAND-NAME</tt> exists, or <code>#f</code> when nothing found.</p>
     389<p>Uses the platform specific PATH environment variable element separator - a semi-colon for Windows, &amp; a colon otherwise.</p>
     390<p>Like the UNIX &quot;which COMMAND-NAME&quot; command.</p></PATH></dd>
     391<dt class="definition"><strong>procedure:</strong> (remove-dotfiles FILES)</dt>
     392<dd>
     393<p>Remove dot files from a directory list. Useful with <code>glob</code>.</p></dd>
     394<div class="subsubsection">
     395<h5>Scheduling Priority</h5>
     396<p>Parameter Descriptions</p><table class="symbol-table">
     397<tr>
     398<td class="symbol">priority/process</td>
     399<td>Process WHICH - WHO is 0 for current process or a process identifier.</td></tr>
     400<tr>
     401<td class="symbol">priority/process-group</td>
     402<td>Process Group WHICH - WHO is 0 for current process group or a process group identifier.</td></tr>
     403<tr>
     404<td class="symbol">priority/user</td>
     405<td>User WHICH - WHO is 0 for current user or a user identifier.</td></tr>
     406<tr>
     407<td class="symbol">PRIORITY</td>
     408<td>An integer [-20 20].</td></tr></table>
     409<br />
     410<dt class="definition"><strong>procedure:</strong> (scheduling-priority WHICH WHO)</dt>
     411<dd>
     412<p>Returns the priority of <tt>WHO</tt> of kind <tt>WHICH</tt>.</p></dd>
     413<dt class="definition"><strong>procedure:</strong> (set-scheduling-priority! WHICH WHO PRIORITY)</dt>
     414<dd>
     415<p>Sets the priority of <tt>WHO</tt> of kind <tt>WHICH</tt> to <tt>PRIORITY</tt>.</p></dd></div>
     416<div class="subsubsection">
     417<h5>Pseudo-TTY</h5>
     418<p>Currently a thin wrapper around the C interface. Scheme bindings for the necessary C constants are not provided.</p>
     419<dt class="definition"><strong>procedure:</strong> (alloc-winsize)</dt>
     420<dd>
     421<p>Returns the pointer to a new C struct winsize.</p></dd>
     422<dt class="definition"><strong>procedure:</strong> (free-winsize (nonnull-pointer WINSIZE))</dt>
     423<dd>
     424<p>Releases a C struct winsize.</p></dd>
     425<p>Accessors for a struct winsize</p><table class="symbol-table">
     426<tr>
     427<td class="symbol">winsize-col</td>
     428<td>Returns ws_col</td></tr>
     429<tr>
     430<td class="symbol">winsize-col-set!</td>
     431<td>Sets ws_col</td></tr>
     432<tr>
     433<td class="symbol">winsize-row</td>
     434<td>Returns ws_row</td></tr>
     435<tr>
     436<td class="symbol">winsize-row-set!</td>
     437<td>Sets ws_row</td></tr>
     438<tr>
     439<td class="symbol">winsize-xpixel</td>
     440<td>Returns ws_xpixel</td></tr>
     441<tr>
     442<td class="symbol">winsize-xpixel-set!</td>
     443<td>Sets ws_xpixel</td></tr>
     444<tr>
     445<td class="symbol">winsize-ypixel</td>
     446<td>Returns ws_ypixel</td></tr>
     447<tr>
     448<td class="symbol">winsize-ypixel-set!</td>
     449<td>Sets ws_ypixel</td></tr></table>
     450<br />
     451<dt class="definition"><strong>procedure:</strong> (alloc-termios)</dt>
     452<dd>
     453<p>Returns the pointer to a new C struct termios.</p></dd>
     454<dt class="definition"><strong>procedure:</strong> (free-termios (nonnull-pointer TERMIOS))</dt>
     455<dd>
     456<p>Releases a C struct termios.</p></dd>
     457<p>Accessors for a struct termios</p><table class="symbol-table">
     458<tr>
     459<td class="symbol">termios-cc</td>
     460<td>Returns c_cc[idx]</td></tr>
     461<tr>
     462<td class="symbol">termios-cc-set!</td>
     463<td>Sets c_cc[idx]</td></tr>
     464<tr>
     465<td class="symbol">termios-cflag</td>
     466<td>Returns c_cflag</td></tr>
     467<tr>
     468<td class="symbol">termios-cflag-set!</td>
     469<td>Sets c_cflag</td></tr>
     470<tr>
     471<td class="symbol">termios-iflag</td>
     472<td>Returns c_iflag</td></tr>
     473<tr>
     474<td class="symbol">termios-iflag-set!</td>
     475<td>Sets c_iflag</td></tr>
     476<tr>
     477<td class="symbol">termios-lflag</td>
     478<td>Returns c_lflag</td></tr>
     479<tr>
     480<td class="symbol">termios-lflag-set!</td>
     481<td>Sets c_lflag</td></tr>
     482<tr>
     483<td class="symbol">termios-oflag</td>
     484<td>Returns c_oflag</td></tr>
     485<tr>
     486<td class="symbol">termios-oflag-set!</td>
     487<td>Sets c_oflag</td></tr>
     488<tr>
     489<td class="symbol">termios-ispeed</td>
     490<td>Returns c_ispeed</td></tr>
     491<tr>
     492<td class="symbol">termios-ispeed-set!</td>
     493<td>Sets c_ispeed</td></tr>
     494<tr>
     495<td class="symbol">termios-ospeed</td>
     496<td>Returns c_ospeed</td></tr>
     497<tr>
     498<td class="symbol">termios-ospeed-set!</td>
     499<td>Sets c_ospeed</td></tr></table>
     500<br />
     501<dt class="definition"><strong>procedure:</strong> (login-tty SLAVE-FILENO)</dt>
     502<dd>
     503<p>The C procedure.</p></dd>
     504<dt class="definition"><strong>procedure:</strong> (open-pty (nonnull-pointer MASTER-FILENO) (nonnull-pointer SLAVE-FILENO) (c-string NAME) (pointer WINSIZE) (pointer TERMIOS))</dt>
     505<dd>
     506<p>The C procedure.</p></dd></div></div>
     507<div class="subsection">
     508<h4>Symbol</h4>
     509<div class="section">
     510<h3>Usage</h3>(require-extension misc-extn-symbol)</div>
     511<dt class="definition"><strong>macro:</strong> (unbound-value)</dt>
     512<dd>
     513<p>Returns the value representing &quot;unbound&quot;.</p></dd>
     514<dt class="definition"><strong>macro:</strong> (unbound-value? OBJECT)</dt>
     515<dd>
     516<p>Is the <tt>OBJECT</tt> the unbound value?</p></dd>
     517<dt class="definition"><strong>macro:</strong> (unbound? SYMBOL)</dt>
     518<dd>
     519<p>Is the <tt>SYMBOL</tt> unbound?</p>
     520<p><tt>SYMBOL</tt> is <b>not</b> treated as a literal, be sure to quote if a literal desired.</p></dd>
     521<dt class="definition"><strong>macro:</strong> (symbol-value SYMBOL [NOT-FOUND #f])</dt>
     522<dd>
     523<p>Returns the <tt>SYMBOL</tt> binding when bound, otherwise the <tt>NOT-FOUND</tt>.</p>
     524<p><tt>SYMBOL</tt> is <b>not</b> treated as a literal, be sure to quote if a literal desired.</p></dd>
     525<dt class="definition"><strong>macro:</strong> (undefined-value)</dt>
     526<dd>
     527<p>Returns the value representing &quot;undefined&quot;.</p></dd>
     528<dt class="definition"><strong>macro:</strong> (undefined-value? OBJECT)</dt>
     529<dd>
     530<p>Is the <tt>OBJECT</tt> the undefined value?</p></dd>
     531<dt class="definition"><strong>macro:</strong> (undefined? OBJECT)</dt>
     532<dd>
     533<p>Is the <tt>OBJECT</tt> the undefined value?</p></dd>
     534<dt class="definition"><strong>procedure:</strong> (make-qualified-symbol NAMESPACE SYMBOL)</dt>
     535<dd>
     536<p>Returns the Chicken namespace qualified <tt>SYMBOL</tt> for the <tt>NAMESPACE</tt>.</p>
     537<p>An exception is generated when the <tt>NAMESPACE</tt> length exceeds the system limit.</p></dd>
     538<dt class="definition"><strong>procedure:</strong> (make-qualified-uninterned-symbol NAMESPACE SYMBOL)</dt>
     539<dd>
     540<p>Returns the Chicken namespace qualified <tt>SYMBOL</tt> for the <tt>NAMESPACE</tt>.</p></dd>
     541<dt class="definition"><strong>procedure:</strong> (qualified-symbol? SYMBOL)</dt>
     542<dd>
     543<p>Is the <tt>SYMBOL</tt> a Chicken namespace qualified symbol.</p></dd>
     544<dt class="definition"><strong>procedure:</strong> (symbol-&gt;qualified-string SYMBOL)</dt>
     545<dd>
     546<p>Returns the printname of a Chicken namespace qualified <tt>SYMBOL</tt>.</p></dd>
     547<dt class="definition"><strong>procedure:</strong> (interned-symbol? SYMBOL)</dt>
     548<dd>
     549<p>Is the <tt>SYMBOL</tt> interned?</p></dd></div>
     550<div class="subsection">
     551<h4>Conditions</h4>
     552<div class="section">
     553<h3>Usage</h3>(require-extension misc-extn-condition)</div>
     554<p>The build condition API macros are currently <b>unavailable</b> when using <b>hygienic</b> macros.</p>
     555<dt class="definition"><strong>macro:</strong> (build-condition-naming-api FORM ...)</dt>
     556<dd>
     557<p>Expands into one or more macros that expand into a condition specification form, suitable for use with <code>build-property-condition-api</code> and <code>build-composite-condition-api</code>.</p>
     558<p>Example: <code>(build-condition-naming (exn location message arguments) foo (bar rope))</code></p>
     559<p>Creates the following:</p>
     560<ul>
     561<li><code>(define-macro (exn-condition) '(exn location message arguments))</code></li>
     562<li><code>(define-macro (foo-condition) 'foo)</code></li>
     563<li><code>(define-macro (bar-condition) '(bar rope))</code></li></ul></dd>
     564<dt class="definition"><strong>macro:</strong> (build-property-condition-api FORM ...)</dt>
     565<dd>
     566<p>Expands into a suite of procedures to construct and test SRFI-12 property condition objects.</p>
     567<p>When only one <tt>FORM</tt> is supplied a single property condition API is built. When more than one <tt>FORM</tt> are supplied then all the property condition APIs are built.</p>
     568<p>When <tt>FORM</tt> is a symbol it is a condition <tt>KIND-KEY</tt> and identifies a condition without properties. When <tt>FORM</tt> is a list the first element is the condition <tt>KIND-KEY</tt> and the following elements are property keys.</p>
     569<p>A condition constructor is named as <tt>make-KIND-KEY-condition</tt> and has 0 or more formal parameters, which are the property keys.</p>
     570<p>A condition predicate is named as <tt>KIND-KEY-condition?</tt> and has 1 formal parameter, the object to test.</p>
     571<p>Property condition constructors without properties always return the same condition object!</p>
     572<p>Example: <code>(build-property-condition-api (exn location message arguments) foo (bar rope))</code></p>
     573<p>Creates the following:</p>
     574<ul>
     575<li><code>(make-exn-condition location message arguments)</code></li>
     576<li><code>(exn-condition? object)</code></li>
     577<li><code>(make-foo-condition)</code></li>
     578<li><code>(foo-condition? object)</code></li>
     579<li><code>(make-bar-condition rope)</code></li>
     580<li><code>(bar-condition? object)</code></li></ul></dd>
     581<dt class="definition"><strong>macro:</strong> (build-composite-condition-api FORM ...)</dt>
     582<dd>
     583<p>Expands into a suite of procedures to construct and test SRFI-12 a composite condition object.</p>
     584<p><tt>FORM</tt> is the same as <tt>FORM</tt> in the <code>build-property-condition-api</code> definition.</p>
     585<p>When zero or one <tt>FORM</tt> are supplied nothing is built. When more than one <tt>FORM</tt> are supplied then a composite API is built.</p>
     586<p>A composite condition constructor is like a property condition constructor, except that the <tt>KIND-KEY</tt> is a concatenation of every condition <tt>KEY</tt>, interspersed with a hyphen.</p>
     587<p>A composite condition predicate is like a property condition predicate, except that the <tt>KIND-KEY</tt> is a concatenation of every condition <tt>KEY</tt>, interspersed with a hyphen.</p>
     588<p>Example: <code>(build-composite-condition-api (exn location message arguments) foo (bar rope))</code></p>
     589<p>Creates the following:</p>
     590<ul>
     591<li><code>(make-exn-foo-bar-condition location message arguments rope)</code></li>
     592<li><code>(exn-foo-bar-condition? object)</code></li></ul></dd>
     593<dt class="definition"><strong>procedure:</strong> (handle-condition THUNK [HANDLER identity])</dt>
     594<dd>
     595<p>Simplified <code>with-exception-handler</code> where the <tt>HANDLER</tt> result is always returned to the caller.</p>
     596<p><tt>HANDLER</tt> is (-&gt; condition object).</p></dd>
     597<dt class="definition"><strong>procedure:</strong> (composite-condition? OBJECT [KIND-KEY ...])</dt>
     598<dd>
     599<p>Is the <tt>OBJECT</tt> a SRFI-12 composite condition?</p>
     600<p>When one or more <tt>KIND-KEY</tt> are supplied then the composite condition must compose at least those kind keys.</p></dd>
     601<dt class="definition"><strong>procedure:</strong> (condition-kind-keys CONDITION)</dt>
     602<dd>
     603<p>Returns a list of the kind-keys of the SRFI-12 <tt>CONDITION</tt>.</p></dd>
     604<dt class="definition"><strong>procedure:</strong> (condition-property-keys CONDITION [KIND-KEY])</dt>
     605<dd>
     606<p>Returns a list of the property-keys for <tt>KIND-KEY</tt> of the SRFI-12 <tt>CONDITION</tt>, or <code>#f</code> when no property keys or the <tt>CONDITION</tt> is not of the kind <tt>KIND-KEY</tt>.</p>
     607<p>When <tt>KIND-KEY</tt> is missing some kind-key of the <tt>CONDITION</tt> is used.</p></dd>
     608<dt class="definition"><strong>procedure:</strong> (condition-properties CONDITION [KIND-KEY])</dt>
     609<dd>
     610<p>Returns an association list of the property keys &amp; values for <tt>KIND-KEY</tt> of the SRFI-12 <tt>CONDITION</tt>, or <code>#f</code> when no property keys or the <tt>CONDITION</tt> is not of the kind <tt>KIND-KEY</tt>.</p>
     611<p>When <tt>KIND-KEY</tt> is missing some kind-key of the <tt>CONDITION</tt> is used.</p></dd>
     612<dt class="definition"><strong>procedure:</strong> (condition-explode CONDITION)</dt>
     613<dd>
     614<p>Returns an association list of every kind-key of the SRFI-12 <tt>CONDITION</tt>. The value of each entry is the result of <code>(condition-properties CONDITION KIND-KEY</code> for that <tt>KIND-KEY</tt>.</p></dd>
     615<dt class="definition"><strong>procedure:</strong> (make-property-condition/list KIND-LIST PROPERTY-LIST)</dt>
     616<dd>
     617<p>Returns a new condition.</p>
     618<p><tt>KIND-LIST</tt> is a list of kind-key.</p>
     619<p><tt>PROPERTY-LIST</tt> is a property list, where the key element is a pair, (&lt;kind-key&gt; . &lt;property-key&gt;).</p></dd></div>
     620<div class="subsection">
     621<h4>Input/Output</h4>
     622<div class="section">
     623<h3>Usage</h3>(require-extension misc-extn-io)</div>
     624<dt class="definition"><strong>procedure:</strong> (cout EXPR ...)</dt>
     625<dd>
     626<p>Like cout &lt;&lt; arguments &lt;&lt; args where argument can be any Scheme object. If it's a procedure (without args) it's executed rather than printed (like newline).</p></dd>
     627<dt class="definition"><strong>procedure:</strong> (cerr EXPR ...)</dt>
     628<dd>
     629<p>Like cerr &lt;&lt; arguments &lt;&lt; args where argument can be any Scheme object. If it's a procedure (without args) it's executed rather than printed (like newline).</p></dd>
     630<dt class="definition"><strong>constant:</strong> nl</dt>
     631<dd>
     632<p>String form of the newline character.</p></dd></div></div>
     633<div class="section">
     634<h3>Contributions</h3>
     635<p>William Annis - hash-let.</p>
     636<p>Oleg Kiselyov's Standard Scheme &quot;Prelude&quot; - ++, ...</p></div>
     637<div class="section">
     638<h3>Examples</h3>
     639<div id="examples">
     640<pre>(use misc-extn-control misc-extn-dsssl)
     641
     642(hash-let ([name (foo &quot;wow&quot;)] some-hashtable)
     643  (print name &quot; &quot; foo #\newline))
     644
     645(stiff-set! x 1 y 2)  ; x = 1 y = 2
     646(fluid-set! x y y x)  ; x = 2 y = 1
     647(swap-set! x y)       ; x = 1 y = 2
     648
     649; Silly example
     650(typecase* (foo bar)
     651  [(procedure macro) #f]
     652  [symbol #t]
     653  [(vector list) #f]
     654  [else
     655    (error &quot;not what I want&quot; it)])
     656
     657;
     658(define (a1 a2 #!optional o1 o2 #!rest rest #!key k1 k2)
     659  (dsssl-fixup '(#:k1 #:k2) ((o1 'x) (o2 'y)) rest
     660    (list o1 o2 rest) ) )
     661; expands into something similar to
     662#;
     663(define (a1 a2 #!optional o1 o2 #!rest rest #!key k1 k2)
     664  (let-values ([(rest o1 o2)
     665                (fixup-extended-lambda-list '(#:k1 #:k2) rest (list o1 'x) (list o2 'y))])
     666    (list o1 o2 rest) ) )</pre></div></div>
     667<div class="section">
    158668<h3>Version</h3>
    159669<ul>
     670<li>3.003 Added list macros. Deprecated alist-delete*. Added misc-extn-dsssl.</li>
    160671<li>3.002 Reverted to 3.0 behavior for unbound Wasn't a bug.</li>
    161672<li>3.001 Bugfix for unbound</li>
     
    187698<li>1.0 Initial release</li></ul></div>
    188699<div class="section">
    189 <h3>Download</h3><a href="misc-extn.egg">misc-extn.egg</a></div>
    190 <div class="section">
    191 <h3>Documentation</h3>
    192 <div class="subsection">
    193 <h4>Record Types</h4>
    194 <div class="section">
    195 <h3>Usage</h3>(require-extension misc-extn-record)</div>
    196 <dt class="definition"><strong>macro:</strong> (define-unchecked-record-type T CTOR PRED [SLOT ...])</dt>
    197 <dd>
    198 <p>SRFI-9 '(define-record-type T CTOR PRED [SLOT ...])', except no checks are made for correct record type before slot access, and the record type symbol is not defined.</p>
    199 <p>For use when slot access is attempted <i>only</i> after determining the correct record type explicitly. Do <i>not</i> make constructed slot access procedures part of a public API.</p></dd>
    200 <dt class="definition"><strong>macro:</strong> (define-inline-unchecked-record-type T CTOR PRED [SLOT ...])</dt>
    201 <dd>
    202 <p>SRFI-9 '(define-record-type T CTOR PRED [SLOT ...])', except no checks are made for correct record type before slot access, the record type symbol is not defined, and  procedures are inline.</p>
    203 <p>For use when slot access is attempted <i>only</i> after determining the correct record type explicitly.</p></dd></div>
    204 <div class="subsection">
    205 <h4>Control Forms</h4>
    206 <div class="section">
    207 <h3>Usage</h3>(require-extension misc-extn-control)</div>
    208 <dt class="definition"><strong>macro:</strong> (typecase EXPRESSION [(TYPE-TEST BODY ...) ...])</dt>
    209 <dd>
    210 <p>Expands into a <code>cond</code> form where every case test is a type test.</p>
    211 <p>A <tt>TYPE-TEST</tt> is either a symbol, which must be the base symbol of a type predicate, a non-null list, which must be a list of the base symbols of type predicates, or the symbol <code>else</code>. An example of a base symbol of a type predicate is <code>symbol</code> and the procedure <code>(symbol? OBJECT)</code> is used for the test.</p>
    212 <p>The <tt>BODY</tt> is not processed. It must be legal as the body of a <code>cond</code> case.</p></dd>
    213 <dt class="definition"><strong>macro:</strong> (typecase* EXPRESSION [(TYPE-TEST BODY ...) ...])</dt>
    214 <dd>
    215 <p>Like <code>typecase</code> but binds local variable <code>it</code> to the value of <tt>EXPRESSION</tt>.</p></dd>
    216 <dt class="definition"><strong>macro:</strong> (whennot CONDITION [BODY ...])</dt>
    217 <dd>
    218 <p>Same as <code>(unless CONDITION [BODY ...])</code>.</p></dd>
    219 <dt class="definition"><strong>macro:</strong> (swap-set! VAR1 VAR2)</dt>
    220 <dd>
    221 <p>Swap settings of <tt>VAR1</tt> &amp; <tt>VAR2</tt>.</p></dd>
    222 <dt class="definition"><strong>macro:</strong> (fluid-set! VAR VAL ...)</dt>
    223 <dd>
    224 <p>Set each variable <tt>VAR</tt> to the value <tt>VAL</tt> in parallel.</p></dd>
    225 <dt class="definition"><strong>macro:</strong> (stiff-set! VAR VAL ...)</dt>
    226 <dd>
    227 <p>Set each variable <tt>VAR</tt> to the value <tt>VAL</tt> in series.</p></dd>
    228 <dt class="definition"><strong>macro:</strong> (hash-let (([VAR | (VAR KEY)] ...) HASH-TABLE) BODY ...)</dt>
    229 <dd>
    230 <p>Decompose <tt>HASH-TABLE</tt> entries into variable bindings. Should the <tt>KEY</tt> not be symbol, or the desired variable name <tt>VAR</tt> should not be the key, the '(VAR KEY)' form can be used. The <tt>BODY ...</tt> is evaluated with the specified bindings.</p></dd>
    231 <dt class="definition"><strong>macro:</strong> (set!/op VAR OP ARG ...)</dt>
    232 <dd>
    233 <p>Sets <tt>VAR</tt> to the value of <code>(OP ARG ...)</code>, where the first occurrence of <code>&lt;&gt;</code> in <tt>ARG ...</tt> is replaced with <tt>VAR</tt>. When there is no occurrence of <code>&lt;&gt;</code> in <tt>ARG ...</tt>the template <tt>(OP &lt;&gt; ARG ...)</tt> is used.</p></dd>
    234 <dt class="definition"><strong>procedure:</strong> (assure EXPRESSION [ERROR-ARGUMENT ...])</dt>
    235 <dd>
    236 <p>When <tt>EXPRESSION</tt> yields <code>#f</code> invoke <code>(error ERROR-ARGUMENT ...)</code>, otherwise return value.</p></dd>
    237 <dt class="definition"><strong>procedure:</strong> (identify-error [CALLER] MSG ARGS ...)</dt>
    238 <dd>
    239 <p>Prints a message like <tt>(error ...)</tt> to <tt>(current-error-port)</tt> but does not throw an exception.</p></dd>
    240 <dt class="definition"><strong>procedure:</strong> (errorf [ID] [FORMAT-STRING ARGS ...])</dt>
    241 <dd>
    242 <p>Same as '(error [ID] (sprintf FORMAT-STRING ARGS ...))'.</p>
    243 <p>The actual argument for the returned procedure is to be a procedure which will be applied with the evaluated expressions as the actual argument list.</p></dd></div>
    244 <div class="subsection">
    245 <h4>Lists</h4>
    246 <div class="section">
    247 <h3>Usage</h3>(require-extension misc-extn-list)</div>
    248 <p>The length test macros terminate early when the test is satisfied; i.e they do not use <code>length</code>.</p>
    249 <dt class="definition"><strong>macro:</strong> (length=0? LIST)</dt>
    250 <dd>
    251 <p>List of length zero?</p></dd>
    252 <dt class="definition"><strong>macro:</strong> (length=1? LIST)</dt>
    253 <dd>
    254 <p>List of length one?</p></dd>
    255 <dt class="definition"><strong>macro:</strong> (length=2? LIST)</dt>
    256 <dd>
    257 <p>List of length two?</p></dd>
    258 <dt class="definition"><strong>macro:</strong> (length&gt;1? LIST)</dt>
    259 <dd>
    260 <p>List of length greater than one?</p></dd>
    261 <dt class="definition"><strong>macro:</strong> (shift!/set SYM [DEFAULT])</dt>
    262 <dd>
    263 <p>Like <code>shift!</code> in the utils unit but assigns the variable <tt>SYM</tt> the <code>'()</code> after shifting from a list of length 1.</p></dd>
    264 <p>Error signaling versions of the standard association lookup functions. When the <tt>KEY</tt> is not found and a <tt>DEFAULT</tt> is not supplied an <code>error</code> is invoked.</p>
    265 <dt class="definition"><strong>macro:</strong> (assoc-def KEY ALIST [TEST] [DEFAULT])</dt>
    266 <dd>
    267 <p>The assoc procedure with an optional test and default value.</p></dd>
    268 <dt class="definition"><strong>macro:</strong> (assv-def KEY ALIST [DEFAULT])</dt>
    269 <dd>
    270 <p>The assv procedure with a default value.</p></dd>
    271 <dt class="definition"><strong>macro:</strong> (assq-def KEY ALIST [DEFAULT])</dt>
    272 <dd>
    273 <p>The assq procedure with a default value.</p></dd>
    274 <dt class="definition"><strong>procedure:</strong> (ensure-list OBJECT)</dt>
    275 <dd>
    276 <p>Returns a list, either the list <tt>OBJECT</tt> or <code>(list OBJECT)</code>.</p></dd>
    277 <dt class="definition"><strong>procedure:</strong> (not-null? LIST)</dt>
    278 <dd>
    279 <p>Returns <code>#f</code> if the given <tt>LIST</tt> is empty, and <tt>LIST</tt> otherwise.</p></dd>
    280 <dt class="definition"><strong>procedure:</strong> (filter-rest-argument! REST-LIST [PREDICATE | LIST-OF-KEYWORD])</dt>
    281 <dd>
    282 <p>Destructively remove any keywords &amp; keyword+value items from a <code>#!rest</code> argument list.</p>
    283 <p>When the optional predicate is supplied it must return <code>#t</code> or <code>#f</code> indicating whether the item is to kept or removed. The predicate takes the current item.</p>
    284 <p>When the optional keyword list is supplied only keywords &amp; keyword+value items from the list are removed.</p></dd>
    285 <dt class="definition"><strong>procedure:</strong> (alist-inverse-ref VALUE ALIST [EQUALITY? eqv?] [DEFAULT #f])</dt>
    286 <dd>
    287 <p>Returns the first key associated with <tt>VALUE</tt> in the <tt>ALIST</tt> using the <tt>EQUALITY?</tt> predicate, else <tt>DEFAULT</tt>.</p></dd>
    288 <dt class="definition"><strong>procedure:</strong> (alist-delete* KEY ALIST [COUNT [EQUALITY?]])</dt>
    289 <dd>
    290 <p>Deletes the first (tt COUNT) associations from alist <tt>ALIST</tt>with the given key <tt>KEY</tt>, using key-comparison procedure <tt>EQUALITY?</tt>. The dynamic order in which the various applications of equality are made is from the alist head to the tail.</p>
    291 <p>Returns a new alist. The alist is not disordered - elements that appear in the result alist occur in the same order as they occur in the argument alist.</p>
    292 <p>The equality procedure is used to compare the element keys, 'key[i: 0 &lt;= i &lt; (length ALIST)]', of the alist's entries to the key parameter in this way: '(EQUALITY? KEY key[i])'.</p>
    293 <p><tt>COUNT</tt> defaults to essentially, infinity, and <tt>EQUALITY?</tt> defaults to <code>equal?</code>.</p></dd>
    294 <dt class="definition"><strong>procedure:</strong> (alist-delete-first KEY ALIST [EQUALITY?])</dt>
    295 <dd>
    296 <p>Returns <code>(alist-delete* KEY ALIST 1 [EQUALITY?])</code>.</p></dd>
    297 <dt class="definition"><strong>procedure:</strong> (unzip-alist ALIST)</dt>
    298 <dd>
    299 <p>Returns 2 values, a list of the keys &amp; a list of the values from
    300           the <tt>ALIST</tt>.</p></dd></div>
    301 <div class="subsection">
    302 <h4>Arithmetic</h4>
    303 <div class="section">
    304 <h3>Usage</h3>(require-extension misc-extn-numeric)</div>
    305 <dt class="definition"><strong>macro:</strong> (inc VAL)</dt>
    306 <dd>
    307 <p>Read-only increment.</p></dd>
    308 <dt class="definition"><strong>macro:</strong> (dec VAL)</dt>
    309 <dd>
    310 <p>Read-only decrement.</p></dd>
    311 <dt class="definition"><strong>macro:</strong> (++ VAL)</dt>
    312 <dd>
    313 <p>Read-only increment.</p></dd>
    314 <dt class="definition"><strong>macro:</strong> (-- VAL)</dt>
    315 <dd>
    316 <p>Read-only decrement.</p></dd>
    317 <dt class="definition"><strong>macro:</strong> (fx++ VAL)</dt>
    318 <dd>
    319 <p>Read-only fixnum increment.</p></dd>
    320 <dt class="definition"><strong>macro:</strong> (fx-- VAL)</dt>
    321 <dd>
    322 <p>Read-only fixnum decrement.</p></dd>
    323 <dt class="definition"><strong>macro:</strong> (fp++ VAL)</dt>
    324 <dd>
    325 <p>Read-only flonum increment.</p></dd>
    326 <dt class="definition"><strong>macro:</strong> (fp-- VAL)</dt>
    327 <dd>
    328 <p>Read-only flonum decrement.</p></dd>
    329 <dt class="definition"><strong>macro:</strong> (++! VAR)</dt>
    330 <dd>
    331 <p>Mutable increment.</p></dd>
    332 <dt class="definition"><strong>macro:</strong> (--! VAR)</dt>
    333 <dd>
    334 <p>Mutable decrement.</p></dd>
    335 <dt class="definition"><strong>macro:</strong> (fx++! VAR)</dt>
    336 <dd>
    337 <p>Mutable fixnum increment.</p></dd>
    338 <dt class="definition"><strong>macro:</strong> (fx--! VAR)</dt>
    339 <dd>
    340 <p>Mutable fixnum decrement.</p></dd>
    341 <dt class="definition"><strong>macro:</strong> (fp++! VAR)</dt>
    342 <dd>
    343 <p>Mutable flonum increment.</p></dd>
    344 <dt class="definition"><strong>macro:</strong> (fp--! VAR)</dt>
    345 <dd>
    346 <p>Mutable flonum decrement.</p></dd></div>
    347 <div class="subsection">
    348 <h4>Posix</h4>
    349 <div class="section">
    350 <h3>Usage</h3>(require-extension misc-extn-posix)</div>
    351 <dt class="definition"><strong>procedure:</strong> (replace-fileno NEW-FILENO KNOWN-FILENO)</dt>
    352 <dd>
    353 <p>Replaces the meaning of <tt>KNOWN-FILENO</tt> with <tt>NEW-FILENO</tt>. I/O Redirection.</p></dd>
    354 <dt class="definition"><strong>procedure:</strong> (create-directory/parents DIRECTORY)</dt>
    355 <dd>
    356 <p>Ensures the directory pathname <tt>DIRECTORY</tt> exists.</p>
    357 <p>Like the UNIX `&quot;mkdir -p DIRECTORY&quot; command.</p></dd>
    358 <dt class="definition"><strong>procedure:</strong> (create-pathname-directory PATHNAME)</dt>
    359 <dd>
    360 <p>Ensures the directory component of <tt>PATHNAME</tt> exist.</p>
    361 <p>Like the UNIX `&quot;mkdir -p `dirname PATHNAME`&quot; command.</p></dd>
    362 <dt class="definition"><strong>procedure:</strong> (make-program-filename COMMAND)</dt>
    363 <dd>
    364 <p>Returns the platform specific form of an executable command filename.</p>
    365 <p>On Windows the <code>exe</code> extension is added unless an extension is already present. Does nothing on other platforms.</p></dd>
    366 <dt class="definition"><strong>procedure:</strong> (file-exists/directory? FILENAME [DIRECTORY | DIRECTORY-LIST])</dt>
    367 <dd>
    368 <p>Returns the pathname when <tt>FILENAME</tt> exists in the <tt>DIRECTORY</tt>, otherwise <code>#f</code>.</p>
    369 <p><tt>DIRECTORY-LIST</tt> is as for <code>make-pathname</code>.</p>
    370 <p>When only the <tt>FILENAME</tt> parameter supplied then the same as <code>file-exists?</code>.</p></dd>
    371 <dt class="definition"><strong>procedure:</strong> (find-file-pathnames FILENAME [DIRECTORY | DIRECTORY-LIST] ...)</dt>
    372 <dd>
    373 <p>Returns a list of all pathnames found for <tt>FILENAME</tt> in the supplied directory/directories, or <code>#f</code> when not found.</p>
    374 <p>The list of pathnames is in the same relative order as that of the directory parameter(s).</p></dd>
    375 <dt class="definition"><strong>procedure:</strong> (find-program-pathnames COMMAND-NAME [DIRECTORY | DIRECTORY-LIST] ...)</dt>
    376 <dd>
    377 <p>Returns a list of all pathnames found for <tt>COMMAND-NAME</tt> in the supplied directory/directories, or <code>#f</code> when not found.</p>
    378 <p>Uses <code>make-program-filename</code> to make a filename.</p>
    379 <p>Does not ensure that the file is executable!</p></dd>
    380 <dt class="definition"><strong>procedure:</strong> (which-command-pathname COMMAND-NAME [ENVIRONMENT-VARIABLE </dt>
    381 <dd>
    382 <PATH>])
    383 <p>Returns the first directory in the <tt>ENVIRONMENT-VARIABLE</tt> where a file named <tt>COMMAND-NAME</tt> exists, or <code>#f</code> when nothing found.</p>
    384 <p>Uses the platform specific PATH environment variable element separator - a semi-colon for Windows, &amp; a colon otherwise.</p>
    385 <p>Like the UNIX &quot;which COMMAND-NAME&quot; command.</p></PATH></dd>
    386 <dt class="definition"><strong>procedure:</strong> (remove-dotfiles FILES)</dt>
    387 <dd>
    388 <p>Remove dot files from a directory list. Useful with <code>glob</code>.</p></dd>
    389 <div class="subsubsection">
    390 <h5>Scheduling Priority</h5>
    391 <p>Parameter Descriptions</p><table class="symbol-table">
    392 <tr>
    393 <td class="symbol">priority/process</td>
    394 <td>Process WHICH - WHO is 0 for current process or a process identifier.</td></tr>
    395 <tr>
    396 <td class="symbol">priority/process-group</td>
    397 <td>Process Group WHICH - WHO is 0 for current process group or a process group identifier.</td></tr>
    398 <tr>
    399 <td class="symbol">priority/user</td>
    400 <td>User WHICH - WHO is 0 for current user or a user identifier.</td></tr>
    401 <tr>
    402 <td class="symbol">PRIORITY</td>
    403 <td>An integer [-20 20].</td></tr></table>
    404 <br />
    405 <dt class="definition"><strong>procedure:</strong> (scheduling-priority WHICH WHO)</dt>
    406 <dd>
    407 <p>Returns the priority of <tt>WHO</tt> of kind <tt>WHICH</tt>.</p></dd>
    408 <dt class="definition"><strong>procedure:</strong> (set-scheduling-priority! WHICH WHO PRIORITY)</dt>
    409 <dd>
    410 <p>Sets the priority of <tt>WHO</tt> of kind <tt>WHICH</tt> to <tt>PRIORITY</tt>.</p></dd></div>
    411 <div class="subsubsection">
    412 <h5>Pseudo-TTY</h5>
    413 <p>Currently a thin wrapper around the C interface. Scheme bindings for the necessary C constants are not provided.</p>
    414 <dt class="definition"><strong>procedure:</strong> (alloc-winsize)</dt>
    415 <dd>
    416 <p>Returns the pointer to a new C struct winsize.</p></dd>
    417 <dt class="definition"><strong>procedure:</strong> (free-winsize (nonnull-pointer WINSIZE))</dt>
    418 <dd>
    419 <p>Releases a C struct winsize.</p></dd>
    420 <p>Accessors for a struct winsize</p><table class="symbol-table">
    421 <tr>
    422 <td class="symbol">winsize-col</td>
    423 <td>Returns ws_col</td></tr>
    424 <tr>
    425 <td class="symbol">winsize-col-set!</td>
    426 <td>Sets ws_col</td></tr>
    427 <tr>
    428 <td class="symbol">winsize-row</td>
    429 <td>Returns ws_row</td></tr>
    430 <tr>
    431 <td class="symbol">winsize-row-set!</td>
    432 <td>Sets ws_row</td></tr>
    433 <tr>
    434 <td class="symbol">winsize-xpixel</td>
    435 <td>Returns ws_xpixel</td></tr>
    436 <tr>
    437 <td class="symbol">winsize-xpixel-set!</td>
    438 <td>Sets ws_xpixel</td></tr>
    439 <tr>
    440 <td class="symbol">winsize-ypixel</td>
    441 <td>Returns ws_ypixel</td></tr>
    442 <tr>
    443 <td class="symbol">winsize-ypixel-set!</td>
    444 <td>Sets ws_ypixel</td></tr></table>
    445 <br />
    446 <dt class="definition"><strong>procedure:</strong> (alloc-termios)</dt>
    447 <dd>
    448 <p>Returns the pointer to a new C struct termios.</p></dd>
    449 <dt class="definition"><strong>procedure:</strong> (free-termios (nonnull-pointer TERMIOS))</dt>
    450 <dd>
    451 <p>Releases a C struct termios.</p></dd>
    452 <p>Accessors for a struct termios</p><table class="symbol-table">
    453 <tr>
    454 <td class="symbol">termios-cc</td>
    455 <td>Returns c_cc[idx]</td></tr>
    456 <tr>
    457 <td class="symbol">termios-cc-set!</td>
    458 <td>Sets c_cc[idx]</td></tr>
    459 <tr>
    460 <td class="symbol">termios-cflag</td>
    461 <td>Returns c_cflag</td></tr>
    462 <tr>
    463 <td class="symbol">termios-cflag-set!</td>
    464 <td>Sets c_cflag</td></tr>
    465 <tr>
    466 <td class="symbol">termios-iflag</td>
    467 <td>Returns c_iflag</td></tr>
    468 <tr>
    469 <td class="symbol">termios-iflag-set!</td>
    470 <td>Sets c_iflag</td></tr>
    471 <tr>
    472 <td class="symbol">termios-lflag</td>
    473 <td>Returns c_lflag</td></tr>
    474 <tr>
    475 <td class="symbol">termios-lflag-set!</td>
    476 <td>Sets c_lflag</td></tr>
    477 <tr>
    478 <td class="symbol">termios-oflag</td>
    479 <td>Returns c_oflag</td></tr>
    480 <tr>
    481 <td class="symbol">termios-oflag-set!</td>
    482 <td>Sets c_oflag</td></tr>
    483 <tr>
    484 <td class="symbol">termios-ispeed</td>
    485 <td>Returns c_ispeed</td></tr>
    486 <tr>
    487 <td class="symbol">termios-ispeed-set!</td>
    488 <td>Sets c_ispeed</td></tr>
    489 <tr>
    490 <td class="symbol">termios-ospeed</td>
    491 <td>Returns c_ospeed</td></tr>
    492 <tr>
    493 <td class="symbol">termios-ospeed-set!</td>
    494 <td>Sets c_ospeed</td></tr></table>
    495 <br />
    496 <dt class="definition"><strong>procedure:</strong> (login-tty SLAVE-FILENO)</dt>
    497 <dd>
    498 <p>The C procedure.</p></dd>
    499 <dt class="definition"><strong>procedure:</strong> (open-pty (nonnull-pointer MASTER-FILENO) (nonnull-pointer SLAVE-FILENO) (c-string NAME) (pointer WINSIZE) (pointer TERMIOS))</dt>
    500 <dd>
    501 <p>The C procedure.</p></dd></div></div>
    502 <div class="subsection">
    503 <h4>Symbol</h4>
    504 <div class="section">
    505 <h3>Usage</h3>(require-extension misc-extn-symbol)</div>
    506 <dt class="definition"><strong>macro:</strong> (unbound-value)</dt>
    507 <dd>
    508 <p>Returns the value representing &quot;unbound&quot;.</p></dd>
    509 <dt class="definition"><strong>macro:</strong> (unbound-value? OBJECT)</dt>
    510 <dd>
    511 <p>Is the <tt>OBJECT</tt> the unbound value?</p></dd>
    512 <dt class="definition"><strong>macro:</strong> (unbound? SYMBOL)</dt>
    513 <dd>
    514 <p>Is the <tt>SYMBOL</tt> unbound?</p>
    515 <p><tt>SYMBOL</tt> is <b>not</b> treated as a literal, be sure to quote if a literal desired.</p></dd>
    516 <dt class="definition"><strong>macro:</strong> (symbol-value SYMBOL [DEFAULT #f])</dt>
    517 <dd>
    518 <p>Returns the <tt>SYMBOL</tt> binding when bound, otherwise the <tt>DEFAULT</tt>.</p>
    519 <p><tt>SYMBOL</tt> is <b>not</b> treated as a literal, be sure to quote if a literal desired.</p></dd>
    520 <dt class="definition"><strong>macro:</strong> (undefined-value)</dt>
    521 <dd>
    522 <p>Returns the value representing &quot;undefined&quot;.</p></dd>
    523 <dt class="definition"><strong>macro:</strong> (undefined-value? OBJECT)</dt>
    524 <dd>
    525 <p>Is the <tt>OBJECT</tt> the undefined value?</p></dd>
    526 <dt class="definition"><strong>macro:</strong> (undefined? OBJECT)</dt>
    527 <dd>
    528 <p>Is the <tt>OBJECT</tt> the undefined value?</p></dd>
    529 <dt class="definition"><strong>procedure:</strong> (make-qualified-symbol NAMESPACE SYMBOL)</dt>
    530 <dd>
    531 <p>Returns the Chicken namespace qualified <tt>SYMBOL</tt> for the <tt>NAMESPACE</tt>.</p>
    532 <p>An exception is generated when the <tt>NAMESPACE</tt> length exceeds the system limit.</p></dd>
    533 <dt class="definition"><strong>procedure:</strong> (make-qualified-uninterned-symbol NAMESPACE SYMBOL)</dt>
    534 <dd>
    535 <p>Returns the Chicken namespace qualified <tt>SYMBOL</tt> for the <tt>NAMESPACE</tt>.</p></dd>
    536 <dt class="definition"><strong>procedure:</strong> (qualified-symbol? SYMBOL)</dt>
    537 <dd>
    538 <p>Is the <tt>SYMBOL</tt> a Chicken namespace qualified symbol.</p></dd>
    539 <dt class="definition"><strong>procedure:</strong> (symbol-&gt;qualified-string SYMBOL)</dt>
    540 <dd>
    541 <p>Returns the printname of a Chicken namespace qualified <tt>SYMBOL</tt>.</p></dd>
    542 <dt class="definition"><strong>procedure:</strong> (interned-symbol? SYMBOL)</dt>
    543 <dd>
    544 <p>Is the <tt>SYMBOL</tt> interned?</p></dd></div>
    545 <div class="subsection">
    546 <h4>Conditions</h4>
    547 <div class="section">
    548 <h3>Usage</h3>(require-extension misc-extn-condition)</div>
    549 <p>The build condition API macros are currently <b>unavailable</b> when using <b>hygienic</b> macros.</p>
    550 <dt class="definition"><strong>macro:</strong> (build-condition-naming-API FORM ...)</dt>
    551 <dd>
    552 <p>Expands into one or more macros that expand into a condition specification form, suitable for use with <code>build-property-condition-API</code> and <code>build-composite-condition-API</code>.</p>
    553 <p>Example: <code>(build-condition-naming (exn location message arguments) foo (bar rope))</code></p>
    554 <p>Creates the following:</p>
    555 <ul>
    556 <li><code>(define-macro (exn-condition) '(exn location message arguments))</code></li>
    557 <li><code>(define-macro (foo-condition) 'foo)</code></li>
    558 <li><code>(define-macro (bar-condition) '(bar rope))</code></li></ul></dd>
    559 <dt class="definition"><strong>macro:</strong> (build-property-condition-API FORM ...)</dt>
    560 <dd>
    561 <p>Expands into a suite of procedures to construct and test SRFI-12 property condition objects.</p>
    562 <p>When only one <tt>FORM</tt> is supplied a single property condition API is built. When more than one <tt>FORM</tt> are supplied then all the property condition APIs are built.</p>
    563 <p>When <tt>FORM</tt> is a symbol it is a condition <tt>KIND-KEY</tt> and identifies a condition without properties. When <tt>FORM</tt> is a list the first element is the condition <tt>KIND-KEY</tt> and the following elements are property keys.</p>
    564 <p>A condition constructor is named as <tt>make-KIND-KEY-condition</tt> and has 0 or more formal parameters, which are the property keys.</p>
    565 <p>A condition predicate is named as <tt>KIND-KEY-condition?</tt> and has 1 formal parameter, the object to test.</p>
    566 <p>Property condition constructors without properties always return the same condition object!</p>
    567 <p>Example: <code>(build-property-condition-API (exn location message arguments) foo (bar rope))</code></p>
    568 <p>Creates the following:</p>
    569 <ul>
    570 <li><code>(make-exn-condition location message arguments)</code></li>
    571 <li><code>(exn-condition? object)</code></li>
    572 <li><code>(make-foo-condition)</code></li>
    573 <li><code>(foo-condition? object)</code></li>
    574 <li><code>(make-bar-condition rope)</code></li>
    575 <li><code>(bar-condition? object)</code></li></ul></dd>
    576 <dt class="definition"><strong>macro:</strong> (build-composite-condition-API FORM ...)</dt>
    577 <dd>
    578 <p>Expands into a suite of procedures to construct and test SRFI-12 a composite condition object.</p>
    579 <p><tt>FORM</tt> is the same as <tt>FORM</tt> in the <code>build-property-condition-API</code> definition.</p>
    580 <p>When zero or one <tt>FORM</tt> are supplied nothing is built. When more than one <tt>FORM</tt> are supplied then a composite API is built.</p>
    581 <p>A composite condition constructor is like a property condition constructor, except that the <tt>KIND-KEY</tt> is a concatenation of every condition <tt>KEY</tt>, interspersed with a hyphen.</p>
    582 <p>A composite condition predicate is like a property condition predicate, except that the <tt>KIND-KEY</tt> is a concatenation of every condition <tt>KEY</tt>, interspersed with a hyphen.</p>
    583 <p>Example: <code>(build-composite-condition-API (exn location message arguments) foo (bar rope))</code></p>
    584 <p>Creates the following:</p>
    585 <ul>
    586 <li><code>(make-exn-foo-bar-condition location message arguments rope)</code></li>
    587 <li><code>(exn-foo-bar-condition? object)</code></li></ul></dd>
    588 <dt class="definition"><strong>procedure:</strong> (handle-condition THUNK [HANDLER identity])</dt>
    589 <dd>
    590 <p>Simplified <code>with-exception-handler</code> where the <tt>HANDLER</tt> result is always returned to the caller.</p>
    591 <p><tt>HANDLER</tt> is (-&gt; condition object).</p></dd>
    592 <dt class="definition"><strong>procedure:</strong> (composite-condition? OBJECT [KIND-KEY ...])</dt>
    593 <dd>
    594 <p>Is the <tt>OBJECT</tt> a SRFI-12 composite condition?</p>
    595 <p>When one or more <tt>KIND-KEY</tt> are supplied then the composite condition must compose at least those kind keys.</p></dd>
    596 <dt class="definition"><strong>procedure:</strong> (condition-kind-keys CONDITION)</dt>
    597 <dd>
    598 <p>Returns a list of the kind-keys of the SRFI-12 <tt>CONDITION</tt>.</p></dd>
    599 <dt class="definition"><strong>procedure:</strong> (condition-property-keys CONDITION [KIND-KEY])</dt>
    600 <dd>
    601 <p>Returns a list of the property-keys for <tt>KIND-KEY</tt> of the SRFI-12 <tt>CONDITION</tt>, or <code>#f</code> when no property keys or the <tt>CONDITION</tt> is not of the kind <tt>KIND-KEY</tt>.</p>
    602 <p>When <tt>KIND-KEY</tt> is missing some kind-key of the <tt>CONDITION</tt> is used.</p></dd>
    603 <dt class="definition"><strong>procedure:</strong> (condition-properties CONDITION [KIND-KEY])</dt>
    604 <dd>
    605 <p>Returns an association list of the property keys &amp; values for <tt>KIND-KEY</tt> of the SRFI-12 <tt>CONDITION</tt>, or <code>#f</code> when no property keys or the <tt>CONDITION</tt> is not of the kind <tt>KIND-KEY</tt>.</p>
    606 <p>When <tt>KIND-KEY</tt> is missing some kind-key of the <tt>CONDITION</tt> is used.</p></dd>
    607 <dt class="definition"><strong>procedure:</strong> (condition-explode CONDITION)</dt>
    608 <dd>
    609 <p>Returns an association list of every kind-key of the SRFI-12 <tt>CONDITION</tt>. The value of each entry is the result of <code>(condition-properties CONDITION KIND-KEY</code> for that <tt>KIND-KEY</tt>.</p></dd>
    610 <dt class="definition"><strong>procedure:</strong> (make-property-condition/list KIND-LIST PROPERTY-LIST)</dt>
    611 <dd>
    612 <p>Returns a new condition.</p>
    613 <p><tt>KIND-LIST</tt> is a list of kind-key.</p>
    614 <p><tt>PROPERTY-LIST</tt> is a property list, where the key element is a pair, (&lt;kind-key&gt; . &lt;property-key&gt;).</p></dd></div>
    615 <div class="subsection">
    616 <h4>Input/Output</h4>
    617 <div class="section">
    618 <h3>Usage</h3>(require-extension misc-extn-io)</div>
    619 <dt class="definition"><strong>procedure:</strong> (cout EXPR ...)</dt>
    620 <dd>
    621 <p>Like cout &lt;&lt; arguments &lt;&lt; args where argument can be any Scheme object. If it's a procedure (without args) it's executed rather than printed (like newline).</p></dd>
    622 <dt class="definition"><strong>procedure:</strong> (cerr EXPR ...)</dt>
    623 <dd>
    624 <p>Like cerr &lt;&lt; arguments &lt;&lt; args where argument can be any Scheme object. If it's a procedure (without args) it's executed rather than printed (like newline).</p></dd>
    625 <dt class="definition"><strong>constant:</strong> nl</dt>
    626 <dd>
    627 <p>String form of the newline character.</p></dd></div></div>
    628 <div class="section">
    629 <h3>Contributions</h3>
    630 <p>William Annis - hash-let.</p>
    631 <p>Oleg Kiselyov's Standard Scheme &quot;Prelude&quot; - ++, ...</p></div>
    632 <div class="section">
    633 <h3>Examples</h3>
    634 <div id="examples">
    635 <pre>(use misc-extn-control)
    636 
    637 (hash-let ([name (foo &quot;wow&quot;)] some-hashtable)
    638   (print name &quot; &quot; foo #\newline))
    639 
    640 (stiff-set! x 1 y 2)  ; x = 1 y = 2
    641 (fluid-set! x y y x)  ; x = 2 y = 1
    642 (swap-set! x y)       ; x = 1 y = 2
    643 
    644 ; Silly example
    645 (typecase* (foo bar)
    646   [(procedure macro) #f]
    647   [symbol #t]
    648   [(vector list) #f]
    649   [else
    650     (error &quot;not what I want&quot; it)])</pre></div></div>
    651 <div class="section">
    652700<h3>License</h3>
    653701<pre>&quot;Copyright (c) 2006-2007, Kon Lovett.  All rights reserved.
  • misc-extn/trunk/misc-extn.meta

    r5437 r6200  
    1414        "misc-extn-posix.scm"
    1515        "misc-extn-list.scm" "misc-extn-list-support.scm"
     16        "misc-extn-dsssl.scm" "misc-extn-dsssl-support.scm"
    1617        "misc-extn-symbol.scm" "misc-extn-symbol-support.scm"
    1718        "misc-extn-control.scm" "misc-extn-control-support.scm"
  • misc-extn/trunk/misc-extn.setup

    r5685 r6200  
    66    (documentation "misc-extn.html")))
    77
     8(install-dynld+syntax misc-extn-list misc-extn-list-support *version* (documentation "misc-extn.html"))
     9(install-dynld+syntax misc-extn-dsssl misc-extn-dsssl-support *version* (documentation "misc-extn.html"))
     10(install-dynld+syntax misc-extn-symbol misc-extn-symbol-support *version* (documentation "misc-extn.html"))
     11(install-dynld+syntax misc-extn-control misc-extn-control-support *version* (documentation "misc-extn.html"))
     12(install-dynld+syntax misc-extn-condition misc-extn-condition-support *version* (documentation "misc-extn.html"))
     13
    814(install-syntax misc-extn-numeric *version* (documentation "misc-extn.html"))
    915(install-syntax misc-extn-record *version* (documentation "misc-extn.html"))
     
    1218(install-dynld misc-extn-posix *version* (documentation "misc-extn.html"))
    1319
    14 (install-dynld+syntax misc-extn-list misc-extn-list-support *version* (documentation "misc-extn.html"))
    15 (install-dynld+syntax misc-extn-symbol misc-extn-symbol-support *version* (documentation "misc-extn.html"))
    16 (install-dynld+syntax misc-extn-control misc-extn-control-support *version* (documentation "misc-extn.html"))
    17 (install-dynld+syntax misc-extn-condition misc-extn-condition-support *version* (documentation "misc-extn.html"))
     20(install-test "misc-extn-test.scm")
Note: See TracChangeset for help on using the changeset viewer.