suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Seems to work but there is a problem with Promise: Type Checker: Street/with-promises-type is not bound as a type in: (force (car (second g))). See graph/__DEBUG_graph__.rkt .

Browse Source
This commit is contained in:
Georges Dupéron 2015-12-07 01:26:04 +01:00
parent 04ddaf308c
commit 191ae7f50e
3 changed files with 61 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
graph/graph/__DEBUG_graph__.rkt Normal file
View File

@ -0,0 +1,9 @@
#lang typed/racket
(require (submod "graph3.lp2.rkt" test))
(require racket/list)
(force (car (second g)))
;(map force (second g))
;(map force (third g))

35
graph/graph/fold-queues.lp2.rkt
View File

@ -48,7 +48,7 @@
(define-syntax/parse <fold-queues-signature> (define-syntax/parse <fold-queues-signature>
;<define-queues-type> ;<define-queues-type>
<define-ids> <define-ids>
((λ (x) (pretty-write (syntax->datum x)) x) #|((λ (x) (pretty-write (syntax->datum x)) x)|#
#'(let () #'(let ()
(begin (begin
(: name/process-element <process-element-type>) (: name/process-element <process-element-type>)
@ -56,10 +56,7 @@
… …
<Δ-hash2-definitions> <Δ-hash2-definitions>
<Δ-results-definitions> <Δ-results-definitions>
<process-queues> <process-queues>)#|)|#)]
;((ann (λ _ (error "fold-queues: Not implemented yet"))
; (→ (List (Vectorof Result-Type) …))))
)))]
@subsection{Representation of the queues} @subsection{Representation of the queues}
@ -82,7 +79,8 @@ which tracks the length of the list (i.e. the first unallocated result index):
@chunk[<Δ-hash2-queue-type> @chunk[<Δ-hash2-queue-type>
(List (HashTable Element-Type Index) (List (HashTable Element-Type Index)
(Listof Element-Type) (Listof Element-Type) ; Reversed stack
(Listof Element-Type) ; Stack
Index)] Index)]
@chunk[<Δ-hash2-type> @chunk[<Δ-hash2-type>
@ -112,14 +110,14 @@ database type opaque, and use an accessor with signature
(if (hash-has-key? (car name/queue) elt) (if (hash-has-key? (car name/queue) elt)
(values (hash-ref (car name/queue) elt) (values (hash-ref (car name/queue) elt)
qs) qs)
(match-let ([(list h l i) name/queue]) (match-let ([(list h rs s i) name/queue])
(let* ([new-h (hash-set h elt i)] (let* ([new-h (hash-set h elt i)]
[new-l (cons elt l)] ;; whoops, should append, not cons! [new-s (cons elt s)]
[new-i (+ i 1)] [new-i (+ i 1)]
[new-i-index (if (index? new-i) [new-i-index (if (index? new-i)
new-i new-i
(error "Too many elements"))] (error "Too many elements"))]
[name/queue (list new-h new-l new-i-index)]) [name/queue (list new-h rs new-s new-i-index)])
(values i (values i
(list name/queue …)))))] (list name/queue …)))))]
…)))] …)))]
@ -128,22 +126,25 @@ database type opaque, and use an accessor with signature
@chunk[<Δ-hash2-dequeue> @chunk[<Δ-hash2-dequeue>
(: Δ-hash2-dequeue (case→ (→ (List (HashTable Element-Type Index) (: Δ-hash2-dequeue (case→ (→ (List (HashTable Element-Type Index)
(Pairof Element-Type (Listof Element-Type) ;; TODO: (P (L))
(Listof Element-Type)) (Listof Element-Type) ;; TODO: (P (L))
Index) Index)
(values Element-Type (values Element-Type
<Δ-hash2-queue-type>)) <Δ-hash2-queue-type>))
…)) …))
(define (Δ-hash2-dequeue q) (define (Δ-hash2-dequeue q)
(match-let* ([(list h (cons e rest-l) i) q]) (match q
[(list h (cons e rest-rs) s i)
(values e (values e
(list h rest-l (assert (- i 1) index?)))))] (list h rest-rs s (assert (- i 1) index?)))]
[(list h '() s i)
(Δ-hash2-dequeue (list h (reverse s) '() i))]))]
@subsubsection{Constructor for the queues} @subsubsection{Constructor for the queues}
@chunk[<Δ-hash2-empty> @chunk[<Δ-hash2-empty>
(define Δ-hash2-empty (define Δ-hash2-empty
(list (list ((inst hash Element-Type Index)) '() 0) (list (list ((inst hash Element-Type Index)) '() '() 0)
…))] …))]
@subsection{Result lists} @subsection{Result lists}
@ -188,7 +189,8 @@ position in the vector equal to the index associated to it in the hash table:
(: Δ-results-to-vectors (→ Δ-results-type (: Δ-results-to-vectors (→ Δ-results-type
(List (Vectorof Result-Type) …))) (List (Vectorof Result-Type) …)))
(define (Δ-results-to-vectors Δ-results) (define (Δ-results-to-vectors Δ-results)
(match-let ([(list name/queue …) (ann Δ-results (List (Listof Result-Type) …))]) (match-let ([(list name/queue …)
(ann Δ-results (List (Listof Result-Type) …))])
(list (vector->immutable-vector (list (vector->immutable-vector
(ann (list->vector name/queue) (ann (list->vector name/queue)
(Vectorof Result-Type))) (Vectorof Result-Type)))
@ -204,7 +206,8 @@ position in the vector equal to the index associated to it in the hash table:
[results : Δ-results-type]) [results : Δ-results-type])
: (List (Vectorof Result-Type) …) : (List (Vectorof Result-Type) …)
(match-let ([(list name/queue …) queues]) (match-let ([(list name/queue …) queues])
(cond [(not (empty? (cadr name/queue))) (cond [(or (not (empty? (cadr name/queue)))
(not (empty? (caddr name/queue))))
<process-queue>] <process-queue>]
… …
[else (Δ-results-to-vectors results)]))) [else (Δ-results-to-vectors results)])))

38
graph/graph/graph3.lp2.rkt
View File

@ -63,8 +63,8 @@ street names @tc[c], and calls for each element the @tc[m-street] and
@; typecheck (yet). @; typecheck (yet).
@chunk[<m-city> @chunk[<m-city>
[(m-city [c : (Listof (Pairof String String))]) [(m-city [c : (Listof (Pairof String String))])
(City (remove-duplicates (map (curry m-street c) (cars c))) (City (remove-duplicates (map (curry m-street c) (cdrs c)))
(remove-duplicates (map m-person (cdrs c))))]] (remove-duplicates (map m-person (cars c))))]]
@subsubsection{More mappings} @subsubsection{More mappings}
@ -526,8 +526,7 @@ closes over.
(define f (tmpl-fold-instance (List <field-with-indices-type> …) (define f (tmpl-fold-instance (List <field-with-indices-type> …)
Void Void
<index→promise-clause> …)) <index→promise-clause> …))
(cons 'node/with-promises-tag (apply node/make-with-promises (first-value (f (cdr n) (void)))))]
(first-value (f (cdr n) (void)))))]
Where @tc[<field-with-indices-type>] is the @tc[field-type] in which node types Where @tc[<field-with-indices-type>] is the @tc[field-type] in which node types
are replaced by tagged indices: are replaced by tagged indices:
@ -579,7 +578,7 @@ are replaced by tagged indices:
@chunk[<make-graph-constructor> @chunk[<make-graph-constructor>
(define-syntax/parse <signature> (define-syntax/parse <signature>
<define-ids> <define-ids>
((λ (x) (pretty-write (syntax->datum x)) x) #|((λ (x) (pretty-write (syntax->datum x)) x)|#
(template (template
(let () (let ()
(begin <define-placeholder-type>) … (begin <define-placeholder-type>) …
@ -599,7 +598,7 @@ are replaced by tagged indices:
(list node/with-indices→with-promises …) (list node/with-indices→with-promises …)
(ann (root/with-indices→with-promises (ann (root/with-indices→with-promises
(vector-ref root/database 0)) (vector-ref root/database 0))
root/with-promises-type))))))] root/with-promises-type))))#|)|#)]
@section{Conclusion} @section{Conclusion}
@ -635,34 +634,9 @@ are replaced by tagged indices:
<use-example> <use-example>
(provide g)
g g
(require (submod ".." doc)))] (require (submod ".." doc)))]
@chunk[<*> @chunk[<*>