[racket-dev] [plt] Push #20714: master branch updated

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,  <jay at 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 <jay at racket-lang.org> 2010-07-15 14:42
> :
> | Fixing advanced language prim ops
> :
>  M collects/scribblings/htdp-langs/advanced.scrbl |    2 +-
>
> ~~~~~~~~~~
>
> caca804 Jay McCarthy <jay at 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 <jay at 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 @#,elem{@schemevalfont{'}@scheme[_quoted]} (code:comment @#,seclink["beginner-abbr-quote"]{quoted value}))
>       (code:line @#,elem{@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 <jay at cs.byu.edu>
Assistant Professor / Brigham Young University
http://teammccarthy.org/jay

"The glory of God is Intelligence" - D&C 93