This push adds hash table functions to ASL per Shriram's request and the conversation with Matthias. It only adds a small number of mutable hash table functions. The initial association list is given the contract (listof (list X Y)). The hash-ref function does not support the default value thunk.
I made a few small changes to the documentation display as well. I intended this as a first step to deciding between all what hash functions should be in ASL. Jay On Thu, Jul 15, 2010 at 3:45 PM, <j...@racket-lang.org> wrote: > jay has updated `master' from c733accd33 to d17deb5fef. > http://git.racket-lang.org/plt/c733accd33..d17deb5fef > > =====[ 3 Commits ]====================================================== > > Directory summary: > 28.9% collects/lang/private/ > 47.2% collects/scribblings/htdp-langs/ > 23.7% collects/tests/racket/ > > ~~~~~~~~~~ > > f72a71c Jay McCarthy <j...@racket-lang.org> 2010-07-15 14:42 > : > | Fixing advanced language prim ops > : > M collects/scribblings/htdp-langs/advanced.scrbl | 2 +- > > ~~~~~~~~~~ > > caca804 Jay McCarthy <j...@racket-lang.org> 2010-07-15 14:51 > : > | Adding subsections to HTDP language primops docs > : > M collects/scribblings/htdp-langs/prim-ops.rkt | 38 ++++++++++++----------- > > ~~~~~~~~~~ > > d17deb5 Jay McCarthy <j...@racket-lang.org> 2010-07-15 15:45 > : > | Adding hash table functions to ASL > : > M collects/lang/private/advanced-funs.rkt | 20 +++++++++++++++++++- > M collects/lang/private/teachprims.rkt | 10 ++++++++++ > M collects/tests/racket/advanced.rktl | 25 +++++++++++++++++++++++++ > > =====[ Overall Diff ]=================================================== > > collects/lang/private/advanced-funs.rkt > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > --- OLD/collects/lang/private/advanced-funs.rkt > +++ NEW/collects/lang/private/advanced-funs.rkt > @@ -106,4 +106,22 @@ > (set-box! (box any -> void) > "to update a box") > (box? (any -> boolean) > - "to determine if a value is a box")))) > + "to determine if a value is a box")) > + > + ("Hash Tables" > + ((advanced-make-hash make-hash) ((listof (list X Y)) -> (hash X Y)) > + "to construct a hash table from a list of associations") > + (hash-set! ((hash X Y) X Y -> void) > + "to update a hash table with a new association") > + ((advanced-hash-ref hash-ref) ((hash X Y) X -> Y) > + "to extract the value associated with a key from a hash table") > + (hash-has-key? ((hash X Y) X -> boolean) > + "to determine if a key is associated with a value in a > hash table") > + (hash-remove! ((hash X Y) X -> void) > + "to remove an association from a hash table") > + (hash-map ((hash X Y) (X Y -> A) -> (listof A)) > + "to construct a new list by applying a function to each > association of a hash table") > + (hash-for-each ((hash X Y) (X Y -> any) -> void) > + "to apply a function to each association of a hash table > for effect only") > + (hash? (any -> boolean) > + "to determine if value is a hash table")))) > > collects/lang/private/teachprims.rkt > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > --- OLD/collects/lang/private/teachprims.rkt > +++ NEW/collects/lang/private/teachprims.rkt > @@ -345,6 +345,14 @@ namespace. > (check-last/cycle 'append x) > (apply append x))) > > +(define-teach advanced hash-ref > + (lambda (h k) > + (hash-ref h k))) > + > +(define-teach advanced make-hash > + (lambda (a) > + (make-hash (map (lambda (l) (cons (first l) (second l))) a)))) > + > (provide > false? > beginner-not > @@ -375,6 +383,8 @@ namespace. > advanced-cons > advanced-list* > advanced-append > + advanced-hash-ref > + advanced-make-hash > cyclic-list?) > > ;; > ----------------------------------------------------------------------------- > > collects/scribblings/htdp-langs/advanced.scrbl > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > --- OLD/collects/scribblings/htdp-langs/advanced.scrbl > +++ NEW/collects/scribblings/htdp-langs/advanced.scrbl > @@ -82,7 +82,7 @@ > (time expr) > empty > (code:line id (code:comment @#,seclink["intermediate-id"]{identifier})) > - (code:line prim-op (code:comment > @#,seclink["intermediate-lambda-prim-op"]{primitive operation})) > + (code:line prim-op (code:comment > @#,seclink["advanced-prim-ops"]{primitive operation})) > (code:line @#,el...@schemevalfont{'}...@scheme[_quoted]} (code:comment > @#,seclink["beginner-abbr-quote"]{quoted value})) > (code:line @#,el...@schemevalfont{`}@scheme[_quasiquoted]} > (code:comment @#,seclink["beginner-abbr-quasiquote"]{quasiquote})) > number > > collects/scribblings/htdp-langs/prim-ops.rkt > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > --- OLD/collects/scribblings/htdp-langs/prim-ops.rkt > +++ NEW/collects/scribblings/htdp-langs/prim-ops.rkt > @@ -47,7 +47,7 @@ > (hspace 1)) > (to-paragraph > (typeset-type (cadr func))))) > - > + > (define (prim-ops lib ctx-stx) > (let ([ops (map (lambda (cat) > (cons (car cat) > @@ -93,21 +93,23 @@ > (apply > append > (map (lambda (category) > - (filter values > - (map > - (lambda (func) > - (let ([id (datum->syntax ctx-stx (car func))]) > - (and (not (ormap > - (lambda (ns) > - (free-label-identifier=? > - id > - (parameterize ([current-namespace > ns]) > - (namespace-syntax-introduce > (datum->syntax #f (car func)))))) > - not-in-ns)) > - (let ([desc-strs (cddr func)]) > - (defthing/proc > - id > - (to-paragraph (typeset-type (cadr func))) > - (cons "Purpose: " desc-strs)))))) > - (sort-category category)))) > + (cons > + (subsection #:tag-prefix (format "~a" lib) (car category)) > + (filter values > + (map > + (lambda (func) > + (let ([id (datum->syntax ctx-stx (car func))]) > + (and (not (ormap > + (lambda (ns) > + (free-label-identifier=? > + id > + (parameterize ([current-namespace > ns]) > + (namespace-syntax-introduce > (datum->syntax #f (car func)))))) > + not-in-ns)) > + (let ([desc-strs (cddr func)]) > + (defthing/proc > + id > + (to-paragraph (typeset-type (cadr func))) > + (cons "Purpose: " desc-strs)))))) > + (sort-category category))))) > ops))))) > > collects/tests/racket/advanced.rktl > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > --- OLD/collects/tests/racket/advanced.rktl > +++ NEW/collects/tests/racket/advanced.rktl > @@ -208,6 +208,31 @@ > (htdp-test #t 'equal~? (equal~? (shared ([x (cons 10 x)]) x) (shared ([x > (cons 10.02 x)]) x) 0.1)) > (htdp-test #f 'equal~? (equal~? (shared ([x (cons 10 x)]) x) (shared ([x > (cons 10.2 x)]) x) 0.1)) > > +(htdp-test 42 'hash-for-each > + (local [(define x 0) > + (define (f k v) (set! x 42))] > + (begin (hash-for-each (make-hash (list (list 1 2))) f) > + x))) > +(htdp-test #t 'hash-has-key? (hash-has-key? (make-hash (list (list 1 2))) 1)) > +(htdp-test #f 'hash-has-key? (hash-has-key? (make-hash (list (list 1 2))) 2)) > +(htdp-test (list #f #f) 'hash-map > + (hash-map (make-hash (list (list 1 #t) (list 2 #t))) > + (lambda (k v) (not v)))) > +(htdp-test 1 'hash-ref (hash-ref (make-hash (list (list 'a 1))) 'a)) > +(htdp-test (list #t #f) 'hash-remove! > + (local [(define ht (make-hash (list (list 'a 1))))] > + (list (hash-has-key? ht 'a) > + (begin (hash-remove! ht 'a) > + (hash-has-key? ht 'a))))) > +(htdp-test 2 'hash-set! > + (local [(define ht (make-hash (list (list 'a 1))))] > + (begin (hash-set! ht 'a 2) > + (hash-ref ht 'a)))) > +(htdp-test #t 'hash? > + (hash? (make-hash (list (list 'a 1))))) > +(htdp-test #f 'hash? > + (hash? 1)) > + > ;; Simulate set! in the repl > (module my-advanced-module (lib "htdp-advanced.rkt" "lang") > (define x 10) > -- Jay McCarthy <j...@cs.byu.edu> Assistant Professor / Brigham Young University http://teammccarthy.org/jay "The glory of God is Intelligence" - D&C 93 _________________________________________________ For list-related administrative tasks: http://lists.racket-lang.org/listinfo/dev