Changeset 10003 in project


Ignore:
Timestamp:
03/20/08 23:50:33 (12 years ago)
Author:
Kon Lovett
Message:

Added unit srfi-69. Removed SRFI 69 items from unit extras. Removed SRFI 69 dep by compiler & eval. Bumped version since this is a serious change.

Location:
chicken/trunk
Files:
20 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/NEWS

    r9879 r10003  
     13.0.11
     2
     3- unit srfi-69: new
     4- unit extras: moved SRFI 69 to unit srfi-69
     5
    163.0.10
    27
  • chicken/trunk/README

    r9879 r10003  
    33  (c)2000-2008 Felix L. Winkelmann
    44
    5   version 3.0.10
     5  version 3.0.11
    66
    77
  • chicken/trunk/buildversion

    r9879 r10003  
    1 3.0.10
     13.0.11
  • chicken/trunk/chicken-profile.scm

    r8361 r10003  
    3030  (uses srfi-1
    3131        srfi-13
     32        srfi-69
    3233        posix
    3334        utils))
  • chicken/trunk/compiler.scm

    r8361 r10003  
    321321(define-constant inline-table-size 301)
    322322(define-constant constant-table-size 301)
     323(define-constant file-requirements-size 301)
    323324(define-constant real-name-table-size 997)
    324325(define-constant import-table-size 997)
     
    435436  (set! profile-info-vector-name (make-random-name 'profile-info))
    436437  (set! real-name-table (make-vector real-name-table-size '()))
    437   (set! file-requirements (make-hash-table eq?))
     438  (if file-requirements
     439      (vector-fill! file-requirements '())
     440      (set! file-requirements (make-vector file-requirements-size '())) )
    438441  (if import-table
    439442      (vector-fill! import-table '())
     
    555558                         (let ([ids (map eval (cdr x))])
    556559                           (apply ##sys#require ids)
    557                            (hash-table-update!
     560                           (##sys#hash-table-update!
    558561                            file-requirements 'syntax-requirements (cut lset-union eq? <> ids)
    559562                            (lambda () ids) )
     
    10211024            (for-each lookup-exports-file us) )
    10221025          (when (pair? us)
    1023             (hash-table-update! file-requirements 'uses (cut lset-union eq? us <>) (lambda () us))
     1026            (##sys#hash-table-update! file-requirements 'uses (cut lset-union eq? us <>) (lambda () us))
    10241027            (let ((units (map (lambda (u) (string->c-identifier (stringify u))) us)))
    10251028              (set! used-units (append used-units units)) ) ) ) )
  • chicken/trunk/csi.scm

    r8361 r10003  
    2626
    2727
    28 (declare (uses match))
     28(declare (uses match srfi-69))
    2929
    3030(declare
  • chicken/trunk/distribution/manifest

    r9350 r10003  
    7171scheduler.c
    7272scheduler.exports
     73srfi-69.c
     74srfi-69.exports
    7375srfi-1.c
    7476srfi-1.exports
     
    168170html/unit-srfi-14.html
    169171html/unit-srfi-18.html
     172html/unit-srfi-69.html
    170173html/unit-srfi-4.html
    171174html/unit-tcp.html
     
    183186runtime.c
    184187scheduler.scm
     188srfi-69.scm
    185189srfi-1.scm
    186190srfi-13.scm
     
    196200tests/runtests.sh
    197201tests/srfi-18-tests.scm
     202tests/hash-table-tests.scm
    198203tests/apply-test.scm
    199204tests/embedded1.c
  • chicken/trunk/eval.scm

    r8361 r10003  
    8181     read write newline ##sys#eval-handler ##sys#set-dlopen-flags! cadadr ##sys#lookup-runtime-requirements
    8282     map string->keyword ##sys#abort
    83      ##sys#macroexpand-0 ##sys#macroexpand-1-local) ) ] )
     83     ##sys#macroexpand-0 ##sys#macroexpand-1-local ##sys#hash-table-update!) ) ] )
    8484
    8585(cond-expand
     
    105105
    106106(define ##sys#core-library-modules
    107   '(extras lolevel utils tcp regex regex-extras posix match srfi-1 srfi-4 srfi-13 srfi-14 srfi-18))
     107  '(extras lolevel utils tcp regex regex-extras posix match
     108    srfi-1 srfi-4 srfi-13 srfi-14 srfi-18 srfi-69))
    108109
    109110(define ##sys#explicit-library-modules '())
     
    127128; srfi-12 in unit library
    128129(define-constant builtin-features
    129   '(chicken srfi-2 srfi-6 srfi-10 srfi-12 srfi-23 srfi-28 srfi-30 srfi-31 srfi-39 srfi-69) )
     130  '(chicken srfi-2 srfi-6 srfi-10 srfi-12 srfi-23 srfi-28 srfi-30 srfi-31 srfi-39) )
    130131
    131132(define-constant builtin-features/compiled
     
    496497;;; Lo-level hashtable support:
    497498
     499;; Note:
     500;;
     501;; - Keys are compared using 'eq?'.
     502;; - The fixed "not found" value is #f. So booleans as values are suspect.
     503
    498504(define ##sys#hash-symbol
    499505  (let ([cache-s #f]
     
    517523                (loop (##sys#slot bucket 1)) ) ) ) ) ) )
    518524
    519 (define ##sys#hash-table-set!
    520   (lambda (ht key val)
    521     (let* ((k (##sys#hash-symbol key (##core#inline "C_block_size" ht)))
    522            (bucket0 (##sys#slot ht k)) )
    523       (let loop ((bucket bucket0))
    524         (if (eq? bucket '())
    525             (##sys#setslot ht k (cons (cons key val) bucket0))
    526             (let ((b (##sys#slot bucket 0)))
    527               (if (eq? key (##sys#slot b 0))
    528                   (##sys#setslot b 1 val)
    529                   (loop (##sys#slot bucket 1)) ) ) ) ) ) ) )
     525(define (##sys#hash-table-set! ht key val)
     526  (let* ((k (##sys#hash-symbol key (##core#inline "C_block_size" ht)))
     527         (bucket0 (##sys#slot ht k)) )
     528    (let loop ((bucket bucket0))
     529      (if (eq? bucket '())
     530          (##sys#setslot ht k (cons (cons key val) bucket0))
     531          (let ((b (##sys#slot bucket 0)))
     532            (if (eq? key (##sys#slot b 0))
     533                (##sys#setslot b 1 val)
     534                (loop (##sys#slot bucket 1)) ) ) ) ) ) )
     535
     536(define (##sys#hash-table-update! ht key updtfunc valufunc)
     537  (##sys#hash-table-set! ht key (updtfunc (or (##sys#hash-table-ref ht key) (valufunc)))) )
    530538
    531539(define (##sys#hash-table-for-each p ht)
     
    534542        ((fx>= i len))
    535543      (##sys#for-each (lambda (bucket)
    536                    (p (##sys#slot bucket 0)
    537                       (##sys#slot bucket 1) ) )
    538                  (##sys#slot ht i) ) ) ) )
     544                        (p (##sys#slot bucket 0) (##sys#slot bucket 1) ) )
     545                      (##sys#slot ht i) ) ) ) )
    539546
    540547(define ##sys#hash-table-location
     
    14061413      (define (add-req id)
    14071414        (when comp?
    1408           (hash-table-update!           ; assumes compiler has extras available - will break in the interpreter
     1415          (##sys#hash-table-update!
    14091416           ##compiler#file-requirements
    14101417           'syntax-requirements
  • chicken/trunk/extras.scm

    r9752 r10003  
    3131 (disable-warning redef)
    3232 (foreign-declare #<<EOF
    33 #define C_hashptr(x)   C_fix(x & C_MOST_POSITIVE_FIXNUM)
    3433#define C_mem_compare(to, from, n)   C_fix(C_memcmp(C_c_string(to), C_c_string(from), C_unfix(n)))
    3534EOF
     
    5756      ##sys#read-char-0 ##sys#write-char ##sys#string-append ##sys#gcd ##sys#lcm
    5857      ##sys#fudge ##sys#check-list ##sys#user-read-hook ##sys#check-closure ##sys#check-inexact
    59       ##extras#%equal?-hash
    6058      input-port? make-vector list->vector sort! merge! open-output-string floor
    6159      get-output-string current-output-port display write port? list->string
     
    6563(private extras
    6664  reverse-string-append
    67   fprintf0 generic-write
    68   unbound-value-thunk
    69   %object-uid-hash %eq?-hash %eqv?-hash %equal?-hash
    70   %hash-table-copy %hash-table-ref %hash-table-update! %hash-table-merge!
    71   %hash-table-for-each %hash-table-fold
    72   hash-table-canonical-length hash-table-rehash )
     65  fprintf0 generic-write )
    7366
    7467(declare
    7568  (hide
    76     fprintf0 generic-write
    77     unbound-value-thunk
    78     %object-uid-hash %eq?-hash %eqv?-hash %equal?-hash
    79     %hash-table-copy %hash-table-ref %hash-table-update! %hash-table-merge!
    80     %hash-table-for-each %hash-table-fold
    81     hash-table-canonical-length hash-table-rehash) )
     69    fprintf0 generic-write ) )
    8270
    8371(cond-expand
     
    10189
    10290(register-feature! 'extras)
    103 
    104 
    105 ;;; Unbound Value:
    106 
    107 ;; This only works because of '(no-bound-checks)'
    108 
    109 (define-macro ($unbound-value)
    110  '(##sys#slot '##sys#arbitrary-unbound-symbol 0) )
    111 
    112 (define unbound-value-thunk (lambda () ($unbound-value)))
    113 
    114 (define-macro ($unbound? ?val)
    115   `(eq? ($unbound-value) ,?val) )
    116 
    117 
    118 ;;; Core Inlines:
    119 
    120 (define-macro ($quick-flonum-truncate ?flo)
    121   `(##core#inline "C_quickflonumtruncate" ,?flo) )
    122 
    123 (define-macro ($fix ?wrd)
    124   `(##core#inline "C_fix" ,?wrd) )
    125 
    126 (define-macro ($block? ?obj)
    127   `(##core#inline "C_blockp" ,?obj) )
    128 
    129 (define-macro ($special? ?obj)
    130   `(##core#inline "C_specialp" ,?obj) )
    131 
    132 (define-macro ($port? ?obj)
    133   `(##core#inline "C_portp" ,?obj) )
    134 
    135 (define-macro ($byte-block? ?obj)
    136   `(##core#inline "C_byteblockp" ,?obj) )
    137 
    138 (define-macro ($hash-string ?str)
    139   `(##core#inline "C_hash_string" ,?str) )
    140 
    141 (define-macro ($hash-string-ci ?str)
    142   `(##core#inline "C_hash_string_ci" ,?str) )
    143 
    144 
    145 ;;;
    146 
    147 (define-macro ($immediate? ?obj)
    148   `(not ($block? ,?obj)) )
    14991
    15092
     
    15881530
    15891531
    1590 ;;; Generation of hash-values:
    1591 
    1592 ;; Naming Conventions:
    1593 ;; $foo - macro
    1594 ;; $*foo - local macro (no such thing but at least it looks different)
    1595 ;; %foo - private, usually unchecked, procedure
    1596 ;; ##sys#foo - public, but undocumented, un-checked procedure
    1597 ;; foo - public checked procedure
    1598 ;;
    1599 ;; All '%foo-hash' return a fixnum, not necessarily positive. The "overflow" of
    1600 ;; a, supposedly, unsigned hash value into negative is not checked during
    1601 ;; intermediate computation.
    1602 ;;
    1603 ;; The body of '%eq?-hash' is duplicated in 'eqv?-hash' and the body of '%eqv?-hash'
    1604 ;; is duplicated in '%equal?-hash' to save on procedure calls.
    1605 
    1606 ;; Fixed hash-values:
    1607 
    1608 (define-constant other-hash-value 99)
    1609 (define-constant true-hash-value 256)
    1610 (define-constant false-hash-value 257)
    1611 (define-constant null-hash-value 258)
    1612 (define-constant eof-hash-value 259)
    1613 (define-constant input-port-hash-value 260)
    1614 (define-constant output-port-hash-value 261)
    1615 (define-constant unknown-immediate-hash-value 262)
    1616 
    1617 (define-constant hash-default-bound 536870912)
    1618 
    1619 ;; Force Hash to Bounded Fixnum:
    1620 
    1621 (define-macro ($fxabs ?fxn)
    1622   `(let ([_fxn ,?fxn]) (if (fx< _fxn 0) (fxneg _fxn) _fxn ) ) )
    1623 
    1624 (define-macro ($hash/limit ?hsh ?lim)
    1625   `(fxmod (fxand (foreign-value "C_MOST_POSITIVE_FIXNUM" int)
    1626                  ($fxabs ,?hsh))
    1627           ,?lim) )
    1628 
    1629 ;; Number Hash:
    1630 
    1631 (define-constant flonum-magic 331804471)
    1632 
    1633 #| Not sure which is "better"; went with speed
    1634 (define-macro ($subbyte ?bytvec ?i)
    1635   `(##core#inline "C_subbyte" ,?bytvec ,?i) )
    1636 
    1637 (define-macro ($hash-flonum ?flo)
    1638   `(fx* flonum-magic
    1639         ,(let loop ([idx (fx- (##sys#size 1.0) 1)])
    1640             (if (fx= 0 idx)
    1641                 `($subbyte ,?flo 0)
    1642                 `(fx+ ($subbyte ,?flo ,idx)
    1643                       (fxshl ,(loop (fx- idx 1)) 1))))) )
    1644 |#
    1645 
    1646 (define-macro ($hash-flonum ?flo)
    1647   `(fx* flonum-magic ($quick-flonum-truncate ,?flo)) )
    1648 
    1649 (define (##sys#number-hash-hook obj)
    1650   (%equal?-hash obj) )
    1651 
    1652 (define-macro ($non-fixnum-number-hash ?obj)
    1653   `(cond [(flonum? obj) ($hash-flonum ,?obj)]
    1654          [else          ($fix (##sys#number-hash-hook ,?obj))] ) )
    1655 
    1656 (define-macro ($number-hash ?obj)
    1657   `(cond [(fixnum? obj) ,?obj]
    1658          [else          ($non-fixnum-number-hash ?obj)] ) )
    1659 
    1660 (define (number-hash obj #!optional (bound hash-default-bound))
    1661   (unless (number? obj)
    1662     (##sys#signal-hook #:type 'number-hash "invalid number" obj) )
    1663   (##sys#check-exact bound 'number-hash)
    1664   ($hash/limit ($number-hash obj) bound) )
    1665 
    1666 ;; Object UID Hash:
    1667 
    1668 #; ;NOT YET (no weak-reference)
    1669 (define (%object-uid-hash obj)
    1670   (%uid-hash (##sys#object->uid obj)) )
    1671 
    1672 (define (%object-uid-hash obj)
    1673   (%equal?-hash obj) )
    1674 
    1675 (define (object-uid-hash obj #!optional (bound hash-default-bound))
    1676   (##sys#check-exact bound 'object-uid-hash)
    1677   ($hash/limit (%object-uid-hash obj) bound) )
    1678 
    1679 ;; Symbol Hash:
    1680 
    1681 #; ;NOT YET (no unique-symbol-hash)
    1682 (define-macro ($symbol-hash ?obj)
    1683   `(##sys#slot ,?obj INDEX-OF-UNIQUE-HASH-VALUE-COMPUTED-DURING-SYMBOL-CREATION) )
    1684 
    1685 (define-macro ($symbol-hash ?obj)
    1686   `($hash-string (##sys#slot ,?obj 1)) )
    1687 
    1688 (define (symbol-hash obj #!optional (bound hash-default-bound))
    1689   (##sys#check-symbol obj 'symbol-hash)
    1690   (##sys#check-exact bound 'string-hash)
    1691   ($hash/limit ($symbol-hash obj) bound) )
    1692 
    1693 ;; Keyword Hash:
    1694 
    1695 (define (##sys#check-keyword x . y)
    1696   (unless (keyword? x)
    1697     (##sys#signal-hook #:type-error
    1698                        (and (not (null? y)) (car y))
    1699                        "bad argument type - not a keyword" x) ) )
    1700 
    1701 #; ;NOT YET (no unique-keyword-hash)
    1702 (define-macro ($keyword-hash ?obj)
    1703   `(##sys#slot ,?obj INDEX-OF-UNIQUE-HASH-VALUE-COMPUTED-DURING-KEYWORD-CREATION) )
    1704 
    1705 (define-macro ($keyword-hash ?obj)
    1706   `($hash-string (##sys#slot ,?obj 1)) )
    1707 
    1708 (define (keyword-hash obj #!optional (bound hash-default-bound))
    1709   (##sys#check-keyword obj 'keyword-hash)
    1710   (##sys#check-exact bound 'keyword-hash)
    1711   ($hash/limit ($keyword-hash obj) bound) )
    1712 
    1713 ;; Eq Hash:
    1714 
    1715 (define-macro ($eq?-hash-object? ?obj)
    1716   `(or ($immediate? ,?obj)
    1717        (symbol? ,?obj)
    1718        #; ;NOT YET (no keyword vs. symbol issue)
    1719        (keyword? ,?obj) ) )
    1720 
    1721 (define (%eq?-hash obj)
    1722   (cond [(fixnum? obj)          obj]
    1723         [(char? obj)            (char->integer obj)]
    1724         [(eq? obj #t)           true-hash-value]
    1725         [(eq? obj #f)           false-hash-value]
    1726         [(null? obj)            null-hash-value]
    1727         [(eof-object? obj)      eof-hash-value]
    1728         [(symbol? obj)          ($symbol-hash obj)]
    1729         #; ;NOT YET (no keyword vs. symbol issue)
    1730         [(keyword? obj)         ($keyword-hash obj)]
    1731         [($immediate? obj)      unknown-immediate-hash-value]
    1732         [else                   (%object-uid-hash obj) ] ) )
    1733 
    1734 (define (eq?-hash obj #!optional (bound hash-default-bound))
    1735   (##sys#check-exact bound 'eq?-hash)
    1736   ($hash/limit (%eq?-hash obj) bound) )
    1737 
    1738 (define hash-by-identity eq?-hash)
    1739 
    1740 ;; Eqv Hash:
    1741 
    1742 (define-macro ($eqv?-hash-object? ?obj)
    1743   `(or ($eq?-hash-object? ,?obj)
    1744        (number? ,?obj)) )
    1745 
    1746 (define (%eqv?-hash obj)
    1747   (cond [(fixnum? obj)          obj]
    1748         [(char? obj)            (char->integer obj)]
    1749         [(eq? obj #t)           true-hash-value]
    1750         [(eq? obj #f)           false-hash-value]
    1751         [(null? obj)            null-hash-value]
    1752         [(eof-object? obj)      eof-hash-value]
    1753         [(symbol? obj)          ($symbol-hash obj)]
    1754         #; ;NOT YET (no keyword vs. symbol issue)
    1755         [(keyword? obj)         ($keyword-hash obj)]
    1756         [(number? obj)          ($non-fixnum-number-hash obj)]
    1757         [($immediate? obj)      unknown-immediate-hash-value]
    1758         [else                   (%object-uid-hash obj) ] ) )
    1759 
    1760 (define (eqv?-hash obj #!optional (bound hash-default-bound))
    1761   (##sys#check-exact bound 'eqv?-hash)
    1762   ($hash/limit (%eqv?-hash obj) bound) )
    1763 
    1764 ;; Equal Hash:
    1765 
    1766 ;XXX Be nice if these were parameters
    1767 (define-constant recursive-hash-max-depth 4)
    1768 (define-constant recursive-hash-max-length 4)
    1769 
    1770 (define-macro ($*list-hash ?obj)
    1771   `(fx+ (length ,?obj)
    1772         (recursive-atomic-hash (##sys#slot ,?obj 0) depth)) )
    1773 
    1774 (define-macro ($*pair-hash ?obj)
    1775   `(fx+ (fxshl (recursive-atomic-hash (##sys#slot ,?obj 0) depth) 16)
    1776         (recursive-atomic-hash (##sys#slot ,?obj 1) depth)) )
    1777 
    1778 (define-macro ($*port-hash ?obj)
    1779   `(fx+ (fxshl (##sys#peek-fixnum ,?obj 0) 4) ; Little extra "identity"
    1780         (if (input-port? ,?obj)
    1781             input-port-hash-value
    1782             output-port-hash-value)) )
    1783 
    1784 (define-macro ($*special-vector-hash ?obj)
    1785   `(vector-hash ,?obj (##sys#peek-fixnum ,?obj 0) depth 1) )
    1786 
    1787 (define-macro ($*regular-vector-hash ?obj)
    1788   `(vector-hash ,?obj 0 depth 0) )
    1789 
    1790 (define (%equal?-hash obj)
    1791 
    1792   ; Recurse into some portion of the vector's slots
    1793   (define (vector-hash obj seed depth start)
    1794     (let ([len (##sys#size obj)])
    1795       (let loop ([hsh (fx+ len seed)]
    1796                  [i start]
    1797                  [len (fx- (fxmin recursive-hash-max-length len) start)] )
    1798         (if (fx= len 0)
    1799             hsh
    1800             (loop (fx+ hsh
    1801                        (fx+ (fxshl hsh 4)
    1802                             (recursive-hash (##sys#slot obj i) (fx+ depth 1))))
    1803                   (fx+ i 1)
    1804                   (fx- len 1) ) ) ) ) )
    1805 
    1806   ; Don't recurse into structured objects
    1807   (define (recursive-atomic-hash obj depth)
    1808     (if (or ($eqv?-hash-object? obj)
    1809             ($byte-block? obj))
    1810         (recursive-hash obj (fx+ depth 1))
    1811         other-hash-value ) )
    1812 
    1813   ; Recurse into structured objects
    1814   (define (recursive-hash obj depth)
    1815     (cond [(fx>= depth recursive-hash-max-depth)
    1816                                   other-hash-value]
    1817           [(fixnum? obj)          obj]
    1818           [(char? obj)            (char->integer obj)]
    1819           [(eq? obj #t)           true-hash-value]
    1820           [(eq? obj #f)           false-hash-value]
    1821           [(null? obj)            null-hash-value]
    1822           [(eof-object? obj)      eof-hash-value]
    1823           [(symbol? obj)          ($symbol-hash obj)]
    1824           #; ;NOT YET (no keyword vs. symbol issue)
    1825           [(keyword? obj)         ($keyword-hash obj)]
    1826           [(number? obj)          ($non-fixnum-number-hash obj)]
    1827           [($immediate? obj)      unknown-immediate-hash-value]
    1828           [($byte-block? obj)     ($hash-string obj)]
    1829           [(list? obj)            ($*list-hash obj)]
    1830           [(pair? obj)            ($*pair-hash obj)]
    1831           [($port? obj)           ($*port-hash obj)]
    1832           [($special? obj)        ($*special-vector-hash obj)]
    1833           [else                   ($*regular-vector-hash obj)] ) )
    1834 
    1835   ;
    1836   (recursive-hash obj 0) )
    1837 
    1838 (define (equal?-hash obj #!optional (bound hash-default-bound))
    1839   (##sys#check-exact bound 'hash)
    1840   ($hash/limit (%equal?-hash obj) bound) )
    1841 
    1842 (define hash equal?-hash)
    1843 
    1844 ;; String Hash:
    1845 
    1846 (define (string-hash str #!optional (bound hash-default-bound))
    1847   (##sys#check-string str 'string-hash)
    1848   (##sys#check-exact bound 'string-hash)
    1849   ($hash/limit ($hash-string str) bound) )
    1850 
    1851 (define (string-ci-hash str #!optional (bound hash-default-bound))
    1852   (##sys#check-string str 'string-ci-hash)
    1853   (##sys#check-exact bound 'string-ci-hash)
    1854   ($hash/limit ($hash-string-ci str) bound) )
    1855 
    1856 
    1857 ;;; Hash-Tables:
    1858 
    1859 ; Predefined sizes for the hash tables:
    1860 ;
    1861 ; Starts with 307; each element is the smallest prime that is at least twice in
    1862 ; magnitude as the previous element in the list.
    1863 ;
    1864 ; The last number is an exception: it is the largest 32-bit fixnum we can represent.
    1865 
    1866 (define-constant hash-table-prime-lengths
    1867   '(307 617
    1868     1237 2477 4957 9923
    1869     19853 39709 79423
    1870     158849 317701 635413
    1871     1270849 2541701 5083423
    1872     10166857 20333759 40667527 81335063 162670129
    1873     325340273 650680571
    1874     ;
    1875     1073741823))
    1876 
    1877 (define-constant hash-table-default-length 307)
    1878 (define-constant hash-table-max-length 1073741823)
    1879 (define-constant hash-table-new-length-factor 2)
    1880 
    1881 (define-constant hash-table-default-min-load 0.5)
    1882 (define-constant hash-table-default-max-load 0.8)
    1883 
    1884 ;; Restrict hash-table length to tabled lengths:
    1885 
    1886 (define (hash-table-canonical-length tab req)
    1887   (let loop ([tab tab])
    1888     (let ([cur (##sys#slot tab 0)]
    1889           [nxt (##sys#slot tab 1)])
    1890       (if (or (fx>= cur req)
    1891               (null? nxt))
    1892           cur
    1893           (loop nxt) ) ) ) )
    1894 
    1895 ;; "Raw" make-hash-table:
    1896 
    1897 (define %make-hash-table
    1898   (let ([make-vector make-vector])
    1899     (lambda (test hash len min-load max-load weak-keys weak-values initial
    1900              #!optional (vec (make-vector len '())))
    1901       (##sys#make-structure 'hash-table
    1902        vec 0 test hash min-load max-load #f #f initial) ) ) )
    1903 
    1904 ;; SRFI-69 & SRFI-90'ish.
    1905 ;;
    1906 ;; Argument list is the pattern
    1907 ;;
    1908 ;; (make-hash-table #!optional test hash size
    1909 ;;                  #!key test hash size initial min-load max-load weak-keys weak-values)
    1910 ;;
    1911 ;; where a keyword argument takes precedence over the corresponding optional
    1912 ;; argument. Keyword arguments MUST come after optional & required
    1913 ;; arugments.
    1914 ;;
    1915 ;; Wish DSSSL (extended) argument list processing Did-What-I-Want (DWIW).
    1916 
    1917 (define make-hash-table
    1918   (let ([core-eq? eq?]
    1919         [core-eqv? eqv?]
    1920         [core-equal? equal?]
    1921         [core-string=? string=?]
    1922         [core-string-ci=? string-ci=?]
    1923         [core= =] )
    1924     (lambda arguments0
    1925       (let ([arguments arguments0]
    1926             [test equal?]
    1927             [hash #f]
    1928             [size hash-table-default-length]
    1929             [initial #f]
    1930             [min-load hash-table-default-min-load]
    1931             [max-load hash-table-default-max-load]
    1932             [weak-keys #f]
    1933             [weak-values #f])
    1934         (let ([hash-for-test
    1935                 (lambda ()
    1936                   (cond [(or (eq? core-eq? test)
    1937                              (eq? eq? test))              eq?-hash]
    1938                         [(or (eq? core-eqv? test)
    1939                              (eq? eqv? test))             eqv?-hash]
    1940                         [(or (eq? core-equal? test)
    1941                              (eq? equal? test))           equal?-hash]
    1942                         [(or (eq? core-string=? test)
    1943                              (eq? string=? test))         string-hash]
    1944                         [(or (eq? core-string-ci=? test)
    1945                              (eq? string-ci=? test))      string-ci-hash]
    1946                         [(or (eq? core= test)
    1947                              (eq? = test))                number-hash]
    1948                         [else                             #f] ) ) ] )
    1949           ; Process optional arguments
    1950           (unless (null? arguments)
    1951             (let ([arg (car arguments)])
    1952               (unless (keyword? arg)
    1953                 (##sys#check-closure arg 'make-hash-table)
    1954                 (set! test arg)
    1955                 (set! arguments (cdr arguments)) ) ) )
    1956           (unless (null? arguments)
    1957             (let ([arg (car arguments)])
    1958               (unless (keyword? arg)
    1959                 (##sys#check-closure arg 'make-hash-table)
    1960                 (set! hash arg)
    1961                 (set! arguments (cdr arguments)) ) ) )
    1962           (unless (null? arguments)
    1963             (let ([arg (car arguments)])
    1964               (unless (keyword? arg)
    1965                 (##sys#check-exact arg 'make-hash-table)
    1966                 (unless (fx< 0 arg)
    1967                   (error 'make-hash-table "invalid size" arg) )
    1968                 (set! size (fxmin hash-table-max-size arg))
    1969                 (set! arguments (cdr arguments)) ) ) )
    1970           ; Process keyword arguments
    1971           (let loop ([args arguments])
    1972             (unless (null? args)
    1973               (let ([arg (car args)])
    1974                 (let ([invarg-err
    1975                         (lambda (msg)
    1976                           (error 'make-hash-table msg arg arguments0))])
    1977                   (if (keyword? arg)
    1978                       (let* ([nxt (cdr args)]
    1979                              [val (if (pair? nxt)
    1980                                       (car nxt)
    1981                                       (invarg-err "missing keyword value"))])
    1982                         (case arg
    1983                           [(#:test)
    1984                             (##sys#check-closure val 'make-hash-table)
    1985                             (set! test val)]
    1986                           [(#:hash)
    1987                             (##sys#check-closure val 'make-hash-table)
    1988                             (set! hash val)]
    1989                           [(#:size)
    1990                             (##sys#check-exact val 'make-hash-table)
    1991                             (unless (fx< 0 val)
    1992                               (error 'make-hash-table "invalid size" val) )
    1993                             (set! size (fxmin hash-table-max-size val))]
    1994                           [(#:initial)
    1995                             (set! initial (lambda () val))]
    1996                           [(#:min-load)
    1997                             (##sys#check-inexact val 'make-hash-table)
    1998                             (unless (and (fp< 0.0 val) (fp< val 1.0))
    1999                               (error 'make-hash-table "invalid min-load" val) )
    2000                             (set! min-load val)]
    2001                           [(#:max-load)
    2002                             (##sys#check-inexact val 'make-hash-table)
    2003                             (unless (and (fp< 0.0 val) (fp< val 1.0))
    2004                               (error 'make-hash-table "invalid max-load" val) )
    2005                             (set! max-load val)]
    2006                           [(#:weak-keys)
    2007                             (set! weak-keys (and val #t))]
    2008                           [(#:weak-values)
    2009                             (set! weak-values (and val #t))]
    2010                           [else
    2011                             (invarg-err "unknown keyword")])
    2012                         (loop (cdr nxt)) )
    2013                       (invarg-err "missing keyword") ) ) ) ) )
    2014           ; Load must be a proper interval
    2015           (when (fp< max-load min-load)
    2016             (error 'make-hash-table "min-load greater than max-load" min-load max-load) )
    2017           ; Force canonical hash-table vector length
    2018           (set! size (hash-table-canonical-length hash-table-prime-lengths size))
    2019           ; Decide on a hash function when not supplied
    2020           (unless hash
    2021             (let ([func (hash-for-test)])
    2022               (if func
    2023                   (set! hash func)
    2024                   (begin
    2025                     (warning 'make-hash-table "user test without user hash")
    2026                     (set! hash equal?-hash) ) ) ) )
    2027           ; Done
    2028           (%make-hash-table test hash size min-load max-load weak-keys weak-values initial) ) ) ) ) )
    2029 
    2030 ;; Hash-Table Predicate:
    2031 
    2032 (define (hash-table? obj)
    2033   (##sys#structure? obj 'hash-table) )
    2034 
    2035 ;; Hash-Table Properties:
    2036 
    2037 (define (hash-table-size ht)
    2038   (##sys#check-structure ht 'hash-table 'hash-table-size)
    2039   (##sys#slot ht 2) )
    2040 
    2041 (define (hash-table-equivalence-function ht)
    2042   (##sys#check-structure ht 'hash-table 'hash-table-equivalence-function)
    2043   (##sys#slot ht 3) )
    2044 
    2045 (define (hash-table-hash-function ht)
    2046   (##sys#check-structure ht 'hash-table 'hash-table-hash-function)
    2047   (##sys#slot ht 4) )
    2048 
    2049 (define (hash-table-min-load ht)
    2050   (##sys#check-structure ht 'hash-table 'hash-table-min-load)
    2051   (##sys#slot ht 5) )
    2052 
    2053 (define (hash-table-max-load ht)
    2054   (##sys#check-structure ht 'hash-table 'hash-table-max-load)
    2055   (##sys#slot ht 6) )
    2056 
    2057 (define (hash-table-weak-keys ht)
    2058   (##sys#check-structure ht 'hash-table 'hash-table-weak-keys)
    2059   (##sys#slot ht 7) )
    2060 
    2061 (define (hash-table-weak-values ht)
    2062   (##sys#check-structure ht 'hash-table 'hash-table-weak-values)
    2063   (##sys#slot ht 8) )
    2064 
    2065 (define (hash-table-has-initial? ht)
    2066   (##sys#check-structure ht 'hash-table 'hash-table-has-initial?)
    2067   (and (##sys#slot ht 9)
    2068        #t ) )
    2069 
    2070 (define (hash-table-initial ht)
    2071   (##sys#check-structure ht 'hash-table 'hash-table-initial)
    2072   (and-let* ([thunk (##sys#slot ht 9)])
    2073     (thunk) ) )
    2074 
    2075 ;; hash-table-copy:
    2076 
    2077 (define %hash-table-copy
    2078   (let ([make-vector make-vector])
    2079     (lambda (ht)
    2080       (let* ([vec1 (##sys#slot ht 1)]
    2081              [len (##sys#size vec1)]
    2082              [vec2 (make-vector len '())] )
    2083         (do ([i 0 (fx+ i 1)])
    2084             [(fx>= i len)
    2085              (%make-hash-table
    2086               (##sys#slot ht 3) (##sys#slot ht 4)
    2087               (##sys#slot ht 2)
    2088               (##sys#slot ht 5) (##sys#slot ht 6)
    2089               (##sys#slot ht 7) (##sys#slot ht 8)
    2090               (##sys#slot ht 9)
    2091               vec2)]
    2092           (##sys#setslot vec2 i
    2093            (let copy-loop ([bucket (##sys#slot vec1 i)])
    2094              (if (null? bucket)
    2095                  '()
    2096                  (let ([pare (##sys#slot bucket 0)])
    2097                    (cons (cons (##sys#slot pare 0) (##sys#slot pare 1))
    2098                          (copy-loop (##sys#slot bucket 1))))))) ) ) ) ) )
    2099 
    2100 (define (hash-table-copy ht)
    2101   (##sys#check-structure ht 'hash-table 'hash-table-copy)
    2102   (%hash-table-copy ht) )
    2103 
    2104 ;; hash-table-update!:
    2105 ;;
    2106 ;; This one was suggested by Sven Hartrumpf (and subsequently added in SRFI-69).
    2107 ;; Modified for ht props min & max load.
    2108 
    2109 (define (hash-table-rehash vec1 vec2 hash)
    2110   (let ([len1 (##sys#size vec1)]
    2111         [len2 (##sys#size vec2)] )
    2112     (do ([i 0 (fx+ i 1)])
    2113         [(fx>= i len1)]
    2114       (let loop ([bucket (##sys#slot vec1 i)])
    2115         (unless (null? bucket)
    2116           (let* ([pare (##sys#slot bucket 0)]
    2117                  [key (##sys#slot pare 0)]
    2118                  [hshidx (hash key len2)] )
    2119             (##sys#setslot vec2 hshidx
    2120                            (cons (cons key (##sys#slot pare 1))
    2121                                  (##sys#slot vec2 hshidx)))
    2122             (loop (##sys#slot bucket 1)) ) ) ) ) ) )
    2123 
    2124 (define %hash-table-update!
    2125   (let ([core-eq? eq?]
    2126         [floor floor] )
    2127     (lambda (ht key func thunk)
    2128       (let ([hash (##sys#slot ht 4)]
    2129             [test (##sys#slot ht 3)]
    2130             [newsiz (fx+ (##sys#slot ht 2) 1)]
    2131             [min-load (##sys#slot ht 5)]
    2132             [max-load (##sys#slot ht 6)] )
    2133         (let re-enter ()
    2134           (let* ([vec (##sys#slot ht 1)]
    2135                  [len (##sys#size vec)] )
    2136             (let ([min-load-len (inexact->exact (floor (* len min-load)))]
    2137                   [max-load-len (inexact->exact (floor (* len max-load)))]
    2138                   [hshidx (hash key len)] )
    2139               ; Need to resize table?
    2140               (if (and (fx< len hash-table-max-length)
    2141                        (fx<= min-load-len newsiz) (fx<= newsiz max-load-len))
    2142                   ; then resize the table:
    2143                   (let ([vec2 (make-vector
    2144                                (hash-table-canonical-length
    2145                                 hash-table-prime-lengths
    2146                                 (fxmin hash-table-max-length
    2147                                        (fx* len hash-table-new-length-factor)))
    2148                                '())])
    2149                     (hash-table-rehash vec vec2 hash)
    2150                     (##sys#setslot ht 1 vec2)
    2151                     (re-enter) )
    2152                   ; else update the table:
    2153                   (let ([bucket0 (##sys#slot vec hshidx)])
    2154                     (if (eq? core-eq? test)
    2155                         ; Fast path (eq? is rewritten by the compiler):
    2156                         (let loop ([bucket bucket0])
    2157                           (cond [(null? bucket)
    2158                                  (let ([val (func (thunk))])
    2159                                    (##sys#setslot vec hshidx (cons (cons key val) bucket0))
    2160                                    (##sys#setslot ht 2 newsiz)
    2161                                    val) ]
    2162                                 [else
    2163                                  (let ([pare (##sys#slot bucket 0)])
    2164                                    (if (eq? key (##sys#slot pare 0))
    2165                                        (let ([val (func (##sys#slot pare 1))])
    2166                                          (##sys#setslot pare 1 val)
    2167                                          val)
    2168                                        (loop (##sys#slot bucket 1)) ) ) ] ) )
    2169                         ; Slow path
    2170                         (let loop ([bucket bucket0])
    2171                           (cond [(null? bucket)
    2172                                  (let ([val (func (thunk))])
    2173                                    (##sys#setslot vec hshidx (cons (cons key val) bucket0))
    2174                                    (##sys#setslot ht 2 newsiz)
    2175                                    val) ]
    2176                                 [else
    2177                                  (let ([pare (##sys#slot bucket 0)])
    2178                                    (if (test key (##sys#slot pare 0))
    2179                                        (let ([val (func (##sys#slot pare 1))])
    2180                                          (##sys#setslot pare 1 val)
    2181                                          val)
    2182                                        (loop (##sys#slot bucket 1)) ) ) ] ) ) ) ) ) ) ) ) ) ) ) )
    2183 
    2184 (define (hash-table-update!
    2185          ht key
    2186          #!optional (func identity)
    2187                     (thunk
    2188                      (let ([thunk (##sys#slot ht 9)])
    2189                        (or thunk
    2190                            (lambda ()
    2191                              (##sys#signal-hook #:access-error
    2192                               'hash-table-update!
    2193                               "hash-table does not contain key" key ht))))))
    2194   (##sys#check-structure ht 'hash-table 'hash-table-update!)
    2195   (##sys#check-closure func 'hash-table-update!)
    2196   (##sys#check-closure thunk 'hash-table-update!)
    2197   (%hash-table-update! ht key func thunk) )
    2198 
    2199 (define (hash-table-update!/default ht key func def)
    2200   (##sys#check-structure ht 'hash-table 'hash-table-update!/default)
    2201   (##sys#check-closure func 'hash-table-update!/default)
    2202   (%hash-table-update! ht key func (lambda () def)) )
    2203 
    2204 (define (hash-table-set! ht key val)
    2205   (##sys#check-structure ht 'hash-table 'hash-table-set!)
    2206   (let ([thunk (lambda _ val)])
    2207     (%hash-table-update! ht key thunk thunk) )
    2208   (void) )
    2209 
    2210 ;; Hash-Table Reference:
    2211 
    2212 (define %hash-table-ref
    2213   (let ([core-eq? eq?])
    2214     (lambda (ht key def)
    2215        (let  ([vec (##sys#slot ht 1)]
    2216               [test (##sys#slot ht 3)] )
    2217          (let* ([hash (##sys#slot ht 4)]
    2218                 [hshidx (hash key (##sys#size vec))] )
    2219            (if (eq? core-eq? test)
    2220                ; Fast path (eq? is rewritten by the compiler):
    2221                (let loop ([bucket (##sys#slot vec hshidx)])
    2222                  (if (null? bucket)
    2223                      (def)
    2224                      (let ([pare (##sys#slot bucket 0)])
    2225                        (if (eq? key (##sys#slot pare 0))
    2226                            (##sys#slot pare 1)
    2227                            (loop (##sys#slot bucket 1)) ) ) ) )
    2228                ; Slow path
    2229                (let loop ([bucket (##sys#slot vec hshidx)])
    2230                  (if (null? bucket)
    2231                      (def)
    2232                      (let ([pare (##sys#slot bucket 0)])
    2233                        (if (test key (##sys#slot pare 0))
    2234                            (##sys#slot pare 1)
    2235                            (loop (##sys#slot bucket 1)) ) ) ) ) ) ) ) ) ) )
    2236 
    2237 (define hash-table-ref
    2238   (getter-with-setter
    2239    (lambda (ht key #!optional (def (lambda ()
    2240                                      (##sys#signal-hook #:access-error
    2241                                       'hash-table-ref
    2242                                       "hash-table does not contain key" key ht))))
    2243      (##sys#check-structure ht 'hash-table 'hash-table-ref)
    2244      (##sys#check-closure def 'hash-table-ref)
    2245      (%hash-table-ref ht key def) )
    2246    hash-table-set!))
    2247 
    2248 (define (hash-table-ref/default ht key default)
    2249   (##sys#check-structure ht 'hash-table 'hash-table-ref/default)
    2250   (%hash-table-ref ht key (lambda () default)) )
    2251 
    2252 (define (hash-table-exists? ht key)
    2253   (##sys#check-structure ht 'hash-table 'hash-table-exists?)
    2254   (not ($unbound? (%hash-table-ref ht key unbound-value-thunk))) )
    2255 
    2256 ;; hash-table-delete!:
    2257 
    2258 (define hash-table-delete!
    2259   (let ([core-eq? eq?])
    2260     (lambda (ht key)
    2261       (##sys#check-structure ht 'hash-table 'hash-table-delete!)
    2262       (let* ([vec (##sys#slot ht 1)]
    2263              [len (##sys#size vec)] )
    2264         (let* ([hash (##sys#slot ht 4)]
    2265                [hshidx (hash key len)] )
    2266           (let ([test (##sys#slot ht 3)]
    2267                 [newsiz (fx- (##sys#slot ht 2) 1)]
    2268                 [bucket0 (##sys#slot vec hshidx)] )
    2269             (if (eq? core-eq? test)
    2270                 ; Fast path (eq? is rewritten by the compiler):
    2271                 (let loop ([prev #f] [bucket bucket0])
    2272                   (and (not (null? bucket))
    2273                        (let ([pare (##sys#slot bucket 0)]
    2274                              [nxt (##sys#slot bucket 1)])
    2275                          (if (eq? key (##sys#slot pare 0))
    2276                              (begin
    2277                                (if prev
    2278                                    (##sys#setslot prev 1 nxt)
    2279                                    (##sys#setslot vec hshidx nxt) )
    2280                                (##sys#setslot ht 2 newsiz)
    2281                                #t )
    2282                              (loop bucket nxt) ) ) ) )
    2283                 ; Slow path
    2284                 (let loop ([prev #f] [bucket bucket0])
    2285                   (and (not (null? bucket))
    2286                        (let ([pare (##sys#slot bucket 0)]
    2287                              [nxt (##sys#slot bucket 1)])
    2288                          (if (test key (##sys#slot pare 0))
    2289                              (begin
    2290                                (if prev
    2291                                    (##sys#setslot prev 1 nxt)
    2292                                    (##sys#setslot vec hshidx nxt) )
    2293                                (##sys#setslot ht 2 newsiz)
    2294                                #t )
    2295                              (loop bucket nxt) ) ) ) ) ) ) ) ) ) ) )
    2296 
    2297 ;; hash-table-remove!:
    2298 
    2299 (define (hash-table-remove! ht func)
    2300   (##sys#check-structure ht 'hash-table 'hash-table-remove!)
    2301   (##sys#check-closure func 'hash-table-remove!)
    2302   (let* ([vec (##sys#slot ht 1)]
    2303          [len (##sys#size vec)] )
    2304     (let ([siz (##sys#slot ht 2)])
    2305       (do ([i 0 (fx+ i 1)])
    2306           [(fx>= i len) (##sys#setislot ht 2 siz)]
    2307         (let loop ([prev #f] [bucket (##sys#slot vec i)])
    2308           (and (not (null? bucket))
    2309                (let ([pare (##sys#slot bucket 0)]
    2310                      [nxt (##sys#slot bucket 1)])
    2311                  (if (func (##sys#slot pare 0) (##sys#slot pare 1))
    2312                      (begin
    2313                        (if prev
    2314                            (##sys#setslot prev 1 nxt)
    2315                            (##sys#setslot vec i nxt) )
    2316                        (set! siz (fx- siz 1))
    2317                        #t )
    2318                      (loop bucket nxt ) ) ) ) ) ) ) ) )
    2319 
    2320 ;; Hash Table Merge:
    2321 
    2322 (define (%hash-table-merge! ht1 ht2)
    2323   (let* ([vec (##sys#slot ht2 1)]
    2324          [len (##sys#size vec)] )
    2325     (do ([i 0 (fx+ i 1)])
    2326         [(fx>= i len) ht1]
    2327       (do ([lst (##sys#slot vec i) (##sys#slot lst 1)])
    2328           [(null? lst)]
    2329         (let ([b (##sys#slot lst 0)])
    2330           (%hash-table-update! ht1 (##sys#slot b 0)
    2331                                    identity (lambda () (##sys#slot b 1))) ) ) ) ) )
    2332 
    2333 (define (hash-table-merge! ht1 ht2)
    2334   (##sys#check-structure ht1 'hash-table 'hash-table-merge!)
    2335   (##sys#check-structure ht2 'hash-table 'hash-table-merge!)
    2336   (%hash-table-merge! ht1 ht2) )
    2337 
    2338 (define (hash-table-merge ht1 ht2)
    2339   (##sys#check-structure ht1 'hash-table 'hash-table-merge)
    2340   (##sys#check-structure ht2 'hash-table 'hash-table-merge)
    2341   (%hash-table-merge! (%hash-table-copy ht1) ht2) )
    2342 
    2343 ;; Hash-Table <-> Association-List:
    2344 
    2345 (define (hash-table->alist ht)
    2346   (##sys#check-structure ht 'hash-table 'hash-table->alist)
    2347   (let* ([vec (##sys#slot ht 1)]
    2348          [len (##sys#size vec)] )
    2349     (let loop ([i 0] [lst '()])
    2350       (if (fx>= i len)
    2351           lst
    2352           (let loop2 ([bucket (##sys#slot vec i)]
    2353                       [lst lst])
    2354             (if (null? bucket)
    2355                 (loop (fx+ i 1) lst)
    2356                 (loop2 (##sys#slot bucket 1)
    2357                        (let ([x (##sys#slot bucket 0)])
    2358                          (cons (cons (##sys#slot x 0) (##sys#slot x 1)) lst) ) ) ) ) ) ) ) )
    2359 
    2360 (define alist->hash-table
    2361   (let ([make-hash-table make-hash-table])
    2362     (lambda (alist . rest)
    2363       (##sys#check-list alist 'alist->hash-table)
    2364       (let ([ht (apply make-hash-table rest)])
    2365         (for-each (lambda (x)
    2366                     (%hash-table-update! ht (##sys#slot x 0)
    2367                                             identity (lambda () (##sys#slot x 1))) )
    2368                   alist)
    2369         ht ) ) ) )
    2370 
    2371 ;; Hash-Table Keys & Values:
    2372 
    2373 (define (hash-table-keys ht)
    2374   (##sys#check-structure ht 'hash-table 'hash-table-keys)
    2375   (let* ([vec (##sys#slot ht 1)]
    2376          [len (##sys#size vec)] )
    2377     (let loop ([i 0] [lst '()])
    2378       (if (fx>= i len)
    2379           lst
    2380           (let loop2 ([bucket (##sys#slot vec i)]
    2381                       [lst lst])
    2382             (if (null? bucket)
    2383                 (loop (fx+ i 1) lst)
    2384                 (loop2 (##sys#slot bucket 1)
    2385                        (let ([x (##sys#slot bucket 0)])
    2386                          (cons (##sys#slot x 0) lst) ) ) ) ) ) ) ) )
    2387 
    2388 (define (hash-table-values ht)
    2389   (##sys#check-structure ht 'hash-table 'hash-table-values)
    2390   (let* ([vec (##sys#slot ht 1)]
    2391          [len (##sys#size vec)] )
    2392     (let loop ([i 0] [lst '()])
    2393       (if (fx>= i len)
    2394           lst
    2395           (let loop2 ([bucket (##sys#slot vec i)]
    2396                       [lst lst])
    2397             (if (null? bucket)
    2398                 (loop (fx+ i 1) lst)
    2399                 (loop2 (##sys#slot bucket 1)
    2400                        (let ([x (##sys#slot bucket 0)])
    2401                          (cons (##sys#slot x 1) lst) ) ) ) ) ) ) ) )
    2402 
    2403 ;; Mapping Over Hash-Table Keys & Values:
    2404 ;;
    2405 ;; hash-table-for-each:
    2406 ;; hash-table-walk:
    2407 ;; hash-table-fold:
    2408 ;; hash-table-map:
    2409 
    2410 (define (%hash-table-for-each ht proc)
    2411   (let* ([vec (##sys#slot ht 1)]
    2412          [len (##sys#size vec)] )
    2413     (do ([i 0 (fx+ i 1)] )
    2414         [(fx>= i len)]
    2415       (##sys#for-each (lambda (bucket)
    2416                         (proc (##sys#slot bucket 0) (##sys#slot bucket 1)) )
    2417                       (##sys#slot vec i)) ) ) )
    2418 
    2419 (define (%hash-table-fold ht func init)
    2420   (let* ([vec (##sys#slot ht 1)]
    2421          [len (##sys#size vec)] )
    2422     (let loop ([i 0] [acc init])
    2423       (if (fx>= i len)
    2424           acc
    2425           (let fold2 ([bucket (##sys#slot vec i)]
    2426                       [acc acc])
    2427             (if (null? bucket)
    2428                 (loop (fx+ i 1) acc)
    2429                 (let ([pare (##sys#slot bucket 0)])
    2430                   (fold2 (##sys#slot bucket 1)
    2431                          (func (##sys#slot pare 0) (##sys#slot pare 1) acc) ) ) ) ) ) ) ) )
    2432 
    2433 (define (hash-table-fold ht func init)
    2434   (##sys#check-structure ht 'hash-table 'hash-table-fold)
    2435   (##sys#check-closure func 'hash-table-fold)
    2436   (%hash-table-fold ht func init) )
    2437 
    2438 (define (hash-table-for-each ht proc)
    2439   (##sys#check-structure ht 'hash-table 'hash-table-for-each)
    2440   (##sys#check-closure proc 'hash-table-for-each)
    2441   (%hash-table-for-each ht proc) )
    2442 
    2443 (define (hash-table-walk ht proc)
    2444   (##sys#check-structure ht 'hash-table 'hash-table-walk)
    2445   (##sys#check-closure proc 'hash-table-walk)
    2446   (%hash-table-for-each ht proc) )
    2447 
    2448 (define (hash-table-map ht func)
    2449   (##sys#check-structure ht 'hash-table 'hash-table-map)
    2450   (##sys#check-closure func 'hash-table-map)
    2451   (%hash-table-fold ht (lambda (k v a) (cons (func k v) a)) '()) )
    2452 
    2453 ;; Done with Hash-Tables:
    2454 
    2455 (register-feature! 'srfi-69)
    2456 
    24571532
    24581533; Support for queues
  • chicken/trunk/lolevel.scm

    r8361 r10003  
    2828(declare
    2929  (unit lolevel)
    30   (uses extras)
     30  (uses srfi-69)
    3131  (usual-integrations)
    3232  (disable-warning var redef)
  • chicken/trunk/manual/Supported language

    r5945 r10003  
    1111* [[Declarations]]               
    1212* [[Parameters]]                 
    13 * [[Unit library]] basic Scheme definitions
    14 * [[Unit eval]] evaluation and macro-handling
    15 * [[Unit extras]] useful utility definitions
    16 * [[Unit srfi-1]] List Library
     13* [[Unit library]] Basic Scheme definitions
     14* [[Unit eval]] Evaluation and macro-handling
     15* [[Unit extras]] Useful utility definitions
     16* [[Unit srfi-1]] List library
    1717* [[Unit srfi-4]] Homogeneous numeric vectors
    1818* [[Unit srfi-13]] String library
    19 * [[Unit srfi-14]] character set library             
    20 * [[Unit match]] pattern matching runtime-support
    21 * [[Unit regex]] regular expressions
    22 * [[Unit srfi-18]] multithreading
     19* [[Unit srfi-14]] Character set library             
     20* [[Unit match]] Pattern matching runtime-support
     21* [[Unit regex]] Regular expressions
     22* [[Unit srfi-18]] Multithreading
     23* [[Unit srfi-69]] Hash tables
    2324* [[Unit posix]] Unix-like services
    2425* [[Unit utils]] Shell scripting and file operations
    25 * [[Unit tcp]] basic TCP-sockets
    26 * [[Unit lolevel]] low-level operations
     26* [[Unit tcp]] Basic TCP-sockets
     27* [[Unit lolevel]] Low-level operations
    2728
    2829Previous: [[Using the interpreter]]
  • chicken/trunk/manual/The User's Manual

    r9879 r10003  
    33== The User's Manual
    44
    5 This is the user's manual for the Chicken Scheme compiler, version 3.0.10
     5This is the user's manual for the Chicken Scheme compiler, version 3.0.11
    66
    77; [[Overview]] : What is Chicken?
  • chicken/trunk/manual/Unit extras

    r9846 r10003  
    228228
    229229
    230 === Hash tables
    231 
    232 CHICKEN implements SRFI 69 with SRFI 90 extensions. For more information, see
    233 [[http://srfi.schemers.org/srfi-69/srfi-69.html|SRFI-69]] and
    234 [[http://srfi.schemers.org/srfi-90/srfi-90.html|SRFI-90]].
    235 
    236 
    237 ==== make-hash-table
    238 
    239  [procedure] (make-hash-table [TEST HASH SIZE] #:TEST #:HASH #:SIZE #:INITIAL #:MIN-LOAD #:MAX-LOAD #:WEAK-KEYS #:WEAK-VALUES)
    240 
    241 Returns a new {{HASH-TABLE}} with the supplied configuration.
    242 
    243 ; {{TEST}} : The equivalence function.
    244 ; {{HASH}} : The hash function.
    245 ; {{SIZE}} : The expected number of table elements.
    246 ; {{INITIAL}} : The default initial value.
    247 ; {{MIN-LOAD}} : The minimum load factor. A {{flonum}} in (0.0 1.0).
    248 ; {{MAX-LOAD}} : The maximum load factor. A {{flonum}} in (0.0 1.0).
    249 ; {{WEAK-KEYS}} : Use weak references for keys. (Ignored)
    250 ; {{WEAK-VALUES}} : Use weak references for values. (Ignored)
    251 
    252 (No, the keyword parameters are not uppercase.)
    253 
    254 
    255 ==== hash-table?
    256 
    257  [procedure] (hash-table? OBJECT)
    258 
    259 Is the {{OBJECT}} a {{hash-table}}?
    260 
    261 
    262 ==== hash-table-size
    263 
    264  [procedure] (hash-table-size HASH-TABLE)
    265 
    266 The {{HASH-TABLE}} size.
    267 
    268 
    269 ==== hash-table-equivalence-function
    270 
    271  [procedure] (hash-table-equivalence-function HASH-TABLE)
    272 
    273 The {{HASH-TABLE}} {{equivalence-function}}.
    274 
    275 
    276 ==== hash-table-hash-function
    277 
    278  [procedure] (hash-table-hash-function HASH-TABLE)
    279 
    280 The {{HASH-TABLE}} {{hash-function}}.
    281 
    282 
    283 ==== hash-table-min-load
    284 
    285  [procedure] (hash-table-min-load HASH-TABLE)
    286 
    287 The {{HASH-TABLE}} minimum load factor.
    288 
    289 
    290 ==== hash-table-max-load
    291 
    292  [procedure] (hash-table-max-load HASH-TABLE)
    293 
    294 The {{HASH-TABLE}} maximum load factor.
    295 
    296 
    297 ==== hash-table-weak-keys
    298 
    299  [procedure] (hash-table-weak-keys HASH-TABLE)
    300 
    301 Does the {{HASH-TABLE}} weak references for keys?
    302 
    303 
    304 ==== hash-table-weak-values
    305 
    306  [procedure] (hash-table-weak-values HASH-TABLE)
    307 
    308 Does the {{HASH-TABLE}} weak references for values?
    309 
    310 
    311 ==== hash-table-has-initial?
    312 
    313  [procedure] (hash-table-has-initial? HASH-TABLE)
    314 
    315 Does the {{HASH-TABLE}} have a default initial value?
    316 
    317 
    318 ==== hash-table-initial
    319 
    320  [procedure] (hash-table-initial HASH-TABLE)
    321 
    322 The {{HASH-TABLE}} default initial value.
    323 
    324 
    325 ==== hash-table-keys
    326 
    327  [procedure] (hash-table-keys HASH-TABLE)
    328 
    329 Returns a list of the keys in the {{HASH-TABLE}} population.
    330 
    331 
    332 ==== hash-table-values
    333 
    334  [procedure] (hash-table-values HASH-TABLE)
    335 
    336 Returns a list of the values in the {{HASH-TABLE}} population.
    337 
    338 
    339 ==== hash-table->alist
    340 
    341  [procedure] (hash-table->alist HASH-TABLE)
    342 
    343 Returns the population of the {{HASH-TABLE}} as an {{association-list}}.
    344 
    345 
    346 ==== alist->hash-table
    347 
    348  [procedure] (alist->hash-table ASSOCIATION-LIST [MAKE-HASH-TABLE-PARAMETER ...])
    349 
    350 Returns a new {{HASH-TABLE}}, configured using the optional
    351 {{MAKE-HASH-TABLE-PARAMETER ...}}. The {{HASH-TABLE}} is populated from the
    352 {{ASSOCIATION-LIST}}.
    353 
    354 
    355 ==== hash-table-ref
    356 
    357  [procedure] (hash-table-ref HASH-TABLE KEY)
    358 
    359 Returns the {{VALUE}} for the {{KEY}} in the {{HASH-TABLE}}.
    360 
    361 Aborts with an exception when the {{KEY}} is missing.
    362 
    363 
    364 ==== hash-table-ref/default
    365 
    366  [procedure] (hash-table-ref/default HASH-TABLE KEY DEFAULT)
    367 
    368 Returns the {{VALUE}} for the {{KEY}} in the {{HASH-TABLE}}, or the {{DEFAULT}}
    369 when the {{KEY}} is missing.
    370 
    371 
    372 ==== hash-table-exists?
    373 
    374  [procedure] (hash-table-exists? HASH-TABLE KEY)
    375 
    376 Does the {{KEY}} exist in the {{HASH-TABLE}}?
    377 
    378 
    379 ==== hash-table-set!
    380 
    381  [procedure] (hash-table-set! HASH-TABLE KEY VALUE)
    382 
    383 Set the {{VALUE}} for the {{KEY}} in the {{HASH-TABLE}}.
    384 
    385 A setter for {{hash-table-ref}} is defined, so
    386 
    387 <enscript highlight=scheme>
    388 (set! (hash-table-ref HASH-TABLE KEY) VALUE)
    389 </enscript>
    390 
    391 is equivalent to
    392 
    393 <enscript highlight=scheme>
    394 (hash-table-set! HASH-TABLE KEY VALUE)
    395 </enscript>
    396 
    397 
    398 ==== hash-table-update!
    399 
    400  [procedure] (hash-table-update! HASH-TABLE KEY [UPDATE-FUNCTION [DEFAULT-VALUE-FUNCTION]])
    401 
    402 Sets or replaces the {{VALUE}} for {{KEY}} in the {{HASH-TABLE}}.
    403 
    404 The {{UPDATE-FUNCTION}} takes the existing {{VALUE}} for {{KEY}} and returns
    405 the new {{VALUE}}. The default is {{identity}}
    406 
    407 The {{DEFAULT-VALUE-FUNCTION}} is called when the entry for {{KEY}} is missing.
    408 The default uses the {{(hash-table-initial-value)}}, if provided. Otherwise
    409 aborts with an exception.
    410 
    411 Returns the new {{VALUE}}.
    412 
    413 
    414 ==== hash-table-update!/default
    415 
    416  [procedure] (hash-table-update! HASH-TABLE KEY UPDATE-FUNCTION DEFAULT-VALUE)
    417 
    418 Sets or replaces the {{VALUE}} for {{KEY}} in the {{HASH-TABLE}}.
    419 
    420 The {{UPDATE-FUNCTION}} takes the existing {{VALUE}} for {{KEY}} and returns
    421 the new {{VALUE}}.
    422 
    423 The {{DEFAULT-VALUE}} is used when the entry for {{KEY}} is missing.
    424 
    425 Returns the new {{VALUE}}.
    426 
    427 
    428 ==== hash-table-copy
    429 
    430  [procededure] (hash-table-copy HASH-TABLE)
    431 
    432 Returns a shallow copy of the {{HASH-TABLE}}.
    433 
    434 
    435 ==== hash-table-delete!
    436 
    437  [procedure] (hash-table-delete! HASH-TABLE KEY)
    438 
    439 Deletes the entry for {{KEY}} in the {{HASH-TABLE}}.
    440 
    441 
    442 ==== hash-table-remove!
    443 
    444  [procedure] (hash-table-remove! HASH-TABLE PROC)
    445 
    446 Calls {{PROC}} for all entries in {{HASH-TABLE}} with the key and value of each
    447 entry. If {{PROC}} returns true, then that entry is removed.
    448 
    449 
    450 ==== hash-table-merge
    451 
    452  [procedure] (hash-table-merge HASH-TABLE-1 HASH-TABLE-2)
    453 
    454 Returns a new {{HASH-TABLE}} with the union of {{HASH-TABLE-1}} and
    455 {{HASH-TABLE-2}}.
    456 
    457 
    458 ==== hash-table-merge!
    459 
    460  [procedure] (hash-table-merge! HASH-TABLE-1 HASH-TABLE-2)
    461 
    462 Returns {{HASH-TABLE-1}} as the union of {{HASH-TABLE-1}} and
    463 {{HASH-TABLE-2}}.
    464 
    465 
    466 ==== hash-table-map
    467 
    468  [procedure] (hash-table-map HASH-TABLE FUNC)
    469 
    470 Calls {{FUNC}} for all entries in {{HASH-TABLE}} with the key and value of each
    471 entry.
    472 
    473 Returns a list of the results of each call.
    474 
    475 
    476 ==== hash-table-fold
    477 
    478  [procedure] (hash-table-fold HASH-TABLE FUNC INIT)
    479 
    480 Calls {{FUNC}} for all entries in {{HASH-TABLE}} with the key and value of each
    481 entry, and the current folded value. The initial folded value is {{INIT}}.
    482 
    483 Returns the final folded value.
    484 
    485 
    486 ==== hash-table-for-each
    487 
    488  [procedure] (hash-table-for-each HASH-TABLE PROC)
    489 
    490 Calls {{PROC}} for all entries in {{HASH-TABLE}} with the key and value of each
    491 entry.
    492 
    493 
    494 ==== hash-table-walk
    495 
    496  [procedure] (hash-table-walk HASH-TABLE PROC)
    497 
    498 Calls {{PROC}} for all entries in {{HASH-TABLE}} with the key and value of each
    499 entry.
    500 
    501 
    502 === Hash Functions
    503 
    504 All hash functions return a {{fixnum}} in the range [0 {{BOUND}}).
    505 
    506 
    507 ==== number-hash
    508 
    509  [procedure] (number-hash NUMBER [BOUND])
    510 
    511 For use with {{=}} as a {{hash-table-equivalence-function}}.
    512 
    513 
    514 ==== object-uid-hash
    515 
    516  [procedure] (object-uid-hash OBJECT [BOUND])
    517 
    518 Currently a synonym for {{equal?-hash}}.
    519 
    520 
    521 ==== symbol-hash
    522 
    523  [procedure] (symbol-hash SYMBOL [BOUND])
    524 
    525 For use with {{eq?}} as a {{hash-table-equivalence-function}}.
    526 
    527 
    528 ==== keyword-hash
    529 
    530  [procedure] (keyword-hash KEYWORD [BOUND])
    531 
    532 For use with {{eq?}} as a {{hash-table-equivalence-function}}.
    533 
    534 
    535 ==== string-hash
    536 
    537  [procedure] (string-hash STRING [BOUND])
    538 
    539 For use with {{string=?}} as a {{hash-table-equivalence-function}}.
    540 
    541 
    542 ==== string-ci-hash
    543 
    544  [procedure] (string-ci-hash STRING [BOUND])
    545 
    546 For use with {{string-ci=?}} as a {{hash-table-equivalence-function}}.
    547 
    548 
    549 ==== eq?-hash
    550 
    551  [procedure] (eq?-hash OBJECT [BOUND])
    552 
    553 For use with {{eq?}} as a {{hash-table-equivalence-function}}.
    554 
    555 
    556 ==== eqv?-hash
    557 
    558  [procedure] (eqv?-hash OBJECT [BOUND])
    559 
    560 For use with {{eqv?}} as a {{hash-table-equivalence-function}}.
    561 
    562 
    563 ==== equal?-hash
    564 
    565  [procedure] (equal?-hash OBJECT [BOUND])
    566 
    567 For use with {{equal?}} as a {{hash-table-equivalence-function}}.
    568 
    569 
    570 ==== hash
    571 
    572  [procedure] (hash OBJECT [BOUND])
    573 
    574 Synonym for {{equal?-hash}}.
    575 
    576 
    577 ==== hash-by-identity
    578 
    579  [procedure] (hash-by-identity OBJECT [BOUND])
    580 
    581 Synonym for {{eq?-hash}}.
    582 
    583 
    584 
    585230=== Queues
    586231
  • chicken/trunk/manual/Unit srfi-18

    r7187 r10003  
    8888Previous: [[Unit regex]]
    8989
    90 Next: [[Unit posix]]
     90Next: [[Unit srfi-69]]
  • chicken/trunk/rules.make

    r9524 r10003  
    3030LIBCHICKEN_OBJECTS_1 = \
    3131       library eval extras lolevel utils tcp srfi-1 srfi-4 srfi-13 \
    32        srfi-14 srfi-18 $(POSIXFILE) regex scheduler \
     32       srfi-14 srfi-18 srfi-69 $(POSIXFILE) regex scheduler \
    3333       profiler stub match runtime
    3434LIBCHICKEN_SHARED_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=$(O))
     
    3737LIBUCHICKEN_OBJECTS_1 = \
    3838       ulibrary ueval uextras ulolevel uutils utcp usrfi-1 usrfi-4 \
    39        usrfi-13 usrfi-14 usrfi-18 u$(POSIXFILE) uregex scheduler \
     39       usrfi-13 usrfi-14 usrfi-18 usrfi-69 u$(POSIXFILE) uregex scheduler \
    4040       profiler stub match uruntime
    4141LIBUCHICKEN_SHARED_OBJECTS = $(LIBUCHICKEN_OBJECTS_1:=$(O))
     
    4444LIBCHICKENGUI_OBJECTS_1 = \
    4545       library eval extras lolevel utils tcp srfi-1 srfi-4 srfi-13 \
    46        srfi-14 srfi-18 $(POSIXFILE) regex scheduler \
     46       srfi-14 srfi-18 srfi-69 $(POSIXFILE) regex scheduler \
    4747       profiler stub match gui-runtime
    4848LIBCHICKENGUI_SHARED_OBJECTS = $(LIBCHICKENGUI_OBJECTS_1:=$(O))
     
    146146          $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) $(C_COMPILER_SHARED_OPTIONS) \
    147147          $(C_COMPILER_BUILD_RUNTIME_OPTIONS) $< $(C_COMPILER_OUTPUT)
     148srfi-69$(O): srfi-69.c chicken.h $(CHICKEN_CONFIG_H)
     149        $(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) \
     150          $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) $(C_COMPILER_SHARED_OPTIONS) \
     151          $(C_COMPILER_BUILD_RUNTIME_OPTIONS) $< $(C_COMPILER_OUTPUT)
    148152srfi-4$(O): srfi-4.c chicken.h $(CHICKEN_CONFIG_H)
    149153        $(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) \
     
    211215          $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) $(C_COMPILER_SHARED_OPTIONS) \
    212216          $(C_COMPILER_BUILD_UNSAFE_RUNTIME_OPTIONS) $< $(C_COMPILER_OUTPUT)
     217usrfi-69$(O): usrfi-69.c chicken.h $(CHICKEN_CONFIG_H)
     218        $(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) \
     219          $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) $(C_COMPILER_SHARED_OPTIONS) \
     220          $(C_COMPILER_BUILD_UNSAFE_RUNTIME_OPTIONS) $< $(C_COMPILER_OUTPUT)
    213221usrfi-4$(O): usrfi-4.c chicken.h $(CHICKEN_CONFIG_H)
    214222        $(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) \
     
    289297          $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) \
    290298          $(C_COMPILER_BUILD_RUNTIME_OPTIONS) $< $(C_COMPILER_OUTPUT)
     299srfi-69-static$(O): srfi-69.c chicken.h $(CHICKEN_CONFIG_H)
     300        $(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) \
     301          $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) \
     302          $(C_COMPILER_BUILD_RUNTIME_OPTIONS) $< $(C_COMPILER_OUTPUT)
    291303srfi-4-static$(O): srfi-4.c chicken.h $(CHICKEN_CONFIG_H)
    292304        $(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) \
     
    351363          $(C_COMPILER_BUILD_UNSAFE_RUNTIME_OPTIONS) $< $(C_COMPILER_OUTPUT)
    352364usrfi-18-static$(O): usrfi-18.c chicken.h $(CHICKEN_CONFIG_H)
     365        $(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) \
     366          $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) \
     367          $(C_COMPILER_BUILD_UNSAFE_RUNTIME_OPTIONS) $< $(C_COMPILER_OUTPUT)
     368usrfi-69-static$(O): usrfi-69.c chicken.h $(CHICKEN_CONFIG_H)
    353369        $(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) \
    354370          $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) \
     
    876892srfi-18.c: srfi-18.scm
    877893        $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
     894srfi-69.c: srfi-69.scm private-namespace.scm
     895        $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@ -extend private-namespace.scm
    878896utils.c: utils.scm
    879897        $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@
     
    913931usrfi-18.c: srfi-18.scm
    914932        $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@
     933usrfi-69.c: srfi-69.scm private-namespace.scm
     934        $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@ -extend private-namespace.scm
    915935uutils.c: utils.scm
    916936        $(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_UNSAFE_OPTIONS) -output-file $@
     
    953973
    954974distfiles: buildsvnrevision library.c eval.c extras.c lolevel.c utils.c \
    955         tcp.c srfi-1.c srfi-4.c srfi-13.c srfi-14.c srfi-18.c \
     975        tcp.c srfi-1.c srfi-4.c srfi-13.c srfi-14.c srfi-18.c srfi-69.c \
    956976        posixunix.c posixwin.c regex.c scheduler.c profiler.c stub.c match.c \
    957977        ulibrary.c ueval.c uextras.c ulolevel.c \
    958978        uutils.c utcp.c usrfi-1.c usrfi-4.c usrfi-13.c usrfi-14.c \
    959         usrfi-18.c uposixunix.c uposixwin.c uregex.c \
     979        usrfi-18.c usrfi-69.c uposixunix.c uposixwin.c uregex.c \
    960980        chicken-profile.c chicken-setup.c csc.c csi.c \
    961981        chicken.c batch-driver.c compiler.c optimizer.c support.c \
     
    9881008spotless: distclean
    9891009        -$(REMOVE_COMMAND) $(REMOVE_COMMAND_OPTIONS) library.c eval.c extras.c lolevel.c utils.c \
    990           tcp.c srfi-1.c srfi-4.c srfi-13.c srfi-14.c srfi-18.c \
     1010          tcp.c srfi-1.c srfi-4.c srfi-13.c srfi-14.c srfi-18.c srfi-69.c \
    9911011          posixunix.c posixwin.c regex.c scheduler.c profiler.c stub.c match.c \
    9921012          ulibrary.c ueval.c uextras.c ulolevel.c \
    9931013          uutils.c utcp.c usrfi-1.c usrfi-4.c usrfi-13.c usrfi-14.c \
    994           usrfi-18.c uposixunix.c uposixwin.c uregex.c chicken-profile.c chicken-setup.c chicken-bug.c \
     1014          usrfi-18.c usrfi-69.c uposixunix.c uposixwin.c uregex.c chicken-profile.c chicken-setup.c chicken-bug.c \
    9951015          csc.c csi.c \
    9961016          chicken.c batch-driver.c compiler.c optimizer.c support.c \
     
    10411061bootstrap.tar.gz: posixunix.c posixwin.c
    10421062        tar cfz bootstrap.tar.gz library.c eval.c extras.c lolevel.c utils.c tcp.c \
    1043           srfi-1.c srfi-4.c srfi-13.c srfi-14.c srfi-18.c posixunix.c posixwin.c regex.c \
     1063          srfi-1.c srfi-4.c srfi-13.c srfi-14.c srfi-18.c srfi-69.c posixunix.c posixwin.c regex.c \
    10441064          scheduler.c profiler.c stub.c match.c $(COMPILER_OBJECTS_1:=.c)
  • chicken/trunk/scripts/makehtml.scm

    r9160 r10003  
    107107    "Unit regex"
    108108    "Unit srfi-18"
     109    "Unit srfi-69"
    109110    "Unit posix"
    110111    "Unit utils"
  • chicken/trunk/scripts/maketexi.scm

    r9167 r10003  
    55(require-extension syntax-case)
    66(require-extension srfi-1)
     7(require-extension srfi-69)
    78(require-extension posix)
    89(require-extension utils)
     
    4041                             "Unit regex"
    4142                             "Unit srfi-18"
     43                             "Unit srfi-69"
    4244                             "Unit posix"
    4345                             "Unit utils"
  • chicken/trunk/scripts/tools.scm

    r7970 r10003  
    22
    33
    4 (use (srfi 1) posix utils)
     4(use (srfi 1) (srfi 69) posix utils)
    55
    66
  • chicken/trunk/tests/hash-table-tests.scm

    r8506 r10003  
    11;;;; hash-table-tests.scm
     2
     3(use srfi-69)
    24
    35(print "SRFI 69 procedures")
  • chicken/trunk/version.scm

    r9879 r10003  
    1 (define-constant +build-version+ "3.0.10")
     1(define-constant +build-version+ "3.0.11")
Note: See TracChangeset for help on using the changeset viewer.