Started writing fold-queues module, which can process multiple queues with distinct types.
This commit is contained in:
parent
0602d2963e
commit
333a909385
97
graph/graph/fold-queues.lp2.rkt
Normal file
97
graph/graph/fold-queues.lp2.rkt
Normal file
|
@ -0,0 +1,97 @@
|
||||||
|
#lang debug scribble/lp2
|
||||||
|
@(require "../lib/doc.rkt")
|
||||||
|
@doc-lib-setup
|
||||||
|
|
||||||
|
@title[#:style manual-doc-style]{The queue library}
|
||||||
|
|
||||||
|
@(table-of-contents)
|
||||||
|
|
||||||
|
@section{Introduction}
|
||||||
|
|
||||||
|
@section{Implementation}
|
||||||
|
|
||||||
|
@chunk[<fold-queues-signature>
|
||||||
|
(fold-queues root-value
|
||||||
|
[(name [element (~literal :) element-type] Δ-queues get-tag)
|
||||||
|
(~literal :) result-type
|
||||||
|
. body]
|
||||||
|
...)]
|
||||||
|
|
||||||
|
@chunk[<define-enqueue-type>
|
||||||
|
(define/with-syntax get-tag/type
|
||||||
|
#'(∀ (X) (case→ (→ 'name element-type X (values Index X))
|
||||||
|
...)))]
|
||||||
|
|
||||||
|
@chunk[<define-Δ-queues-type>
|
||||||
|
(define/with-syntax queues/type
|
||||||
|
#'(List (Δ-Hash element-type Index) ...))]
|
||||||
|
|
||||||
|
@chunk[<fold-queue-multi-sets-immutable-tags>
|
||||||
|
(define-syntax/parse <fold-queues-signature>
|
||||||
|
<define-enqueue-type>
|
||||||
|
<define-Δ-queues-type>
|
||||||
|
#'(list (λ ([element : element-type]
|
||||||
|
[get-tag : get-tag/type]
|
||||||
|
[Δ-queues : queues/type])
|
||||||
|
: result-type
|
||||||
|
. body)
|
||||||
|
...)
|
||||||
|
#;#'(error "Not implemented yet"))]
|
||||||
|
|
||||||
|
|
||||||
|
@tc[Δ-Hash] is a type encapsulating both a hash, and a set of key-value pairs
|
||||||
|
added to the @tc[Δ-Hash] since its creation from a simple @tc[HashTable].
|
||||||
|
|
||||||
|
@chunk[<Δ-hash>
|
||||||
|
(define-type (Δ-Hash A B)
|
||||||
|
(Pairof (HashTable A B)
|
||||||
|
(Setof (Pairof A B))))
|
||||||
|
|
||||||
|
(: empty-Δ-hash (∀ (K V) (→ (Δ-Hash K V))))
|
||||||
|
(define (empty-Δ-hash)
|
||||||
|
(cons ((inst hash K V)) ((inst set (Pairof K V)))))
|
||||||
|
|
||||||
|
(: Δ-hash (∀ (K V) (→ (HashTable K V) (Δ-Hash K V))))
|
||||||
|
(define (Δ-hash h)
|
||||||
|
(cons h ((inst set (Pairof K V)))))
|
||||||
|
|
||||||
|
(: Δ-hash-add (∀ (K V) (→ (Δ-Hash K V) K V
|
||||||
|
(Δ-Hash K V))))
|
||||||
|
(define (Δ-hash-add dh k v)
|
||||||
|
(if (hash-has-key? (car dh) k)
|
||||||
|
dh
|
||||||
|
(cons (hash-set (car dh) k v)
|
||||||
|
(set-add (cdr dh) (cons k v)))))]
|
||||||
|
|
||||||
|
@section{Conclusion}
|
||||||
|
|
||||||
|
@chunk[<module-main>
|
||||||
|
(module main typed/racket
|
||||||
|
(require (for-syntax syntax/parse
|
||||||
|
racket/syntax
|
||||||
|
"../lib/low-untyped.rkt")
|
||||||
|
"../lib/low.rkt")
|
||||||
|
|
||||||
|
(provide fold-queues)
|
||||||
|
|
||||||
|
<Δ-hash>
|
||||||
|
<fold-queue-multi-sets-immutable-tags>)]
|
||||||
|
|
||||||
|
@chunk[<module-test>
|
||||||
|
(module* test typed/racket
|
||||||
|
(require (submod "..")
|
||||||
|
typed/rackunit)
|
||||||
|
|
||||||
|
; TODO
|
||||||
|
|
||||||
|
(require (submod ".." doc)))]
|
||||||
|
|
||||||
|
@chunk[<*>
|
||||||
|
(begin
|
||||||
|
<module-main>
|
||||||
|
|
||||||
|
(require 'main)
|
||||||
|
(provide (all-from-out 'main))
|
||||||
|
|
||||||
|
<module-test>)]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user