Fix indentation.

Add missing variable annotation.
Remove unecessary annotations.
Now pass.

svn: r9522

original commit: 53709f1faffae5533a8a700582d13a817c829dd6
This commit is contained in:
Sam Tobin-Hochstadt 2008-04-28 21:21:30 +00:00
parent 66febb5ba5
commit 16fffb8706
3 changed files with 22 additions and 29 deletions

View File

@ -77,7 +77,7 @@
(define empty
(case-lambda
[() (make-heap-empty (current-compare))]
[(cmp) (make-heap-empty cmp)]))
[(#{cmp : comparator}) (make-heap-empty cmp)]))
(define: empty? : (pred heap-empty) heap-empty?)
@ -98,11 +98,8 @@
(cond
[(empty? h1) h2]
[(empty? h2) h1]
[else (let*: (;; added new bindings at simpler types
[h1 : (heap-node a) h1]
[h2 : (heap-node a) h2]
[x : a (heap-node-elm h1)] ;; FIXME - FUCK FUCK FUCK - why not x?
[y : a (heap-node-elm h2)])
[else (let* ([x (heap-node-elm h1)]
[y (heap-node-elm h2)])
(if<=? ((heap-compare h1) x y)
(make x (heap-node-left h1) (union (heap-node-right h1) h2))
(make y (heap-node-left h2) (union h1 (heap-node-right h2)))))]))
@ -197,11 +194,8 @@
(heap-node-left h))
(heap-node-right h))))
;; FIXME
(pdefine: (a) (elements [h : (Heap a)]) : (list-of a)
(fold (lambda: ([x : a] [l : (list-of a)]) (cons x l))
#;#{cons : (a (list-of a) -> (list-of a))}
#{'() :: (list-of a)} h))
(fold (lambda: ([x : a] [l : (list-of a)]) (cons x l)) '() h))
(pdefine: (a) (count [x : a] [h : (Heap a)]) : number
(let ([cmp (heap-compare h)])
@ -211,16 +205,20 @@
s))
0 h)))
(pdefine: (a) (-heap . [xs : a]) : (Heap a)
(list->heap xs))
(define: list->heap : (All (a) (case-lambda (comparator (list-of a) -> (Heap a)) ((list-of a) -> (Heap a))))
; time: O(n)
(pcase-lambda: (a)
[([l : (list-of a)]) (list->heap (current-compare) l)]
[([cmp : comparator] [l : (list-of a)])
(let* ([e (empty cmp)]
(let* ([e (#{empty @ a} cmp)]
[hs (map (lambda: ([x : a]) (insert x e)) l)])
; (list heap) -> (list heap)
; merge adjacent pairs of heaps
(define: (merge-pairs [hs : (list-of (Heap a))]) : (list-of (Heap a))
(define: (merge-pairs [hs : (Listof (Heap a))]) : (list-of (Heap a))
(cond
[(or (null? hs)
(null? (cdr hs))) hs]
@ -236,9 +234,6 @@
[(null? (cdr hs)) (car hs)]
[else (loop (merge-pairs hs))]))))]))
;; FIXME - moved to after list->heap
(pdefine: (a) (-heap . [xs : a]) : (Heap a)
(list->heap xs))
(pdefine: (a) (insert* [xs : (list-of a)] [h : (Heap a)]) : (Heap a)

View File

@ -1,9 +1,9 @@
#lang typed-scheme
;;; priority-queue.scm -- Jens Axel Søgaard
;;; PURPOSE
; This file implements priority queues on top of
; a heap library.
#lang typed-scheme
; This file implements priority queues on top of
; a heap library.
(define-type-alias number Number)
(define-type-alias boolean Boolean)
(define-type-alias symbol Symbol)
@ -17,7 +17,7 @@
(require/typed =? ((top top -> number) top top -> boolean) (lib "67.ss" "srfi"))
(require/typed <? ((top top -> number) top top -> boolean) (lib "67.ss" "srfi"))
; a priority-queue is a heap of (cons <priority> <element>)
; a priority-queue is a heap of (cons <priority> <element>)
(define-type-alias (elem a) (cons number a))
@ -25,18 +25,18 @@
(define-type-alias (pqh a) (heap:Heap (elem a)))
; conveniences
; conveniences
(pdefine: (a) (heap [pq : (priority-queue a)]) : (pqh a) (priority-queue-heap pq))
(pdefine: (a) (pri [p : (elem a)]) : number (car p))
(pdefine: (a) (elm [p : (elem a)]) : a (cdr p))
(pdefine: (a) (make [h : (pqh a)]) : (priority-queue a) (make-priority-queue h))
; sort after priority
; TODO: and then element?
; sort after priority
; TODO: and then element?
(pdefine: (a) (compare [p1 : (elem a)] [p2 : (elem a)]) : number
(number-compare (pri p1) (pri p2)))
;;; OPERATIONS
;;; OPERATIONS
(define: (num-elems [h : (heap:Heap (cons number number))]) : (list-of (cons number number))
(heap:elements h))
@ -78,11 +78,9 @@
(pdefine: (a) (insert [x : a] [p : number] [pq : (priority-queue a)]) : (priority-queue a)
(make (heap:insert (#{cons :: (case-lambda (a (list-of a) -> (list-of a)) (number a -> (cons number a)))} p x) (heap pq))))
;; FIXME - had to insert extra binding to give the typechecker more help
;; could have done this with annotation on map, probably
;; FIXME -- too many annotations needed on cons
(pdefine: (a) (insert* [xs : (list-of a)] [ps : (list-of number)] [pq : (priority-queue a)]) : (priority-queue a)
(let ([cons #{cons :: (case-lambda (a (list-of a) -> (list-of a)) (number a -> (cons number a)))}])
(make (heap:insert* (map #{cons :: (number a -> (cons number a))} ps xs) (heap pq)))))
(make (heap:insert* (map #{#{cons @ number a} :: (number a -> (cons number a))} ps xs) (heap pq))))
(pdefine: (a) (delete-min [pq : (priority-queue a)]) : (priority-queue a)
(let ([h (heap pq)])

View File

@ -19,8 +19,8 @@
(pdefine: (b) (heap-size [h : (Heap b)]) : number
(cond [(heap-empty? h) 0]
[(heap-node? h)
(+ 1 (+ (#{heap-size @ b} (heap-node-left h))
(#{heap-size @ b} (heap-node-right h))))]
(+ 1 (+ (heap-size (heap-node-left h))
(heap-size (heap-node-right h))))]
;; FIXME - shouldn't need else clause
[else (error "Never happens!")]))