From 16fffb87068c17ad963c9931cb54d3ecf282b2da Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Mon, 28 Apr 2008 21:21:30 +0000 Subject: [PATCH] Fix indentation. Add missing variable annotation. Remove unecessary annotations. Now pass. svn: r9522 original commit: 53709f1faffae5533a8a700582d13a817c829dd6 --- .../typed-scheme/succeed/leftist-heap.ss | 25 ++++++++----------- .../typed-scheme/succeed/priority-queue.scm | 22 ++++++++-------- .../tests/typed-scheme/succeed/rec-types.ss | 4 +-- 3 files changed, 22 insertions(+), 29 deletions(-) diff --git a/collects/tests/typed-scheme/succeed/leftist-heap.ss b/collects/tests/typed-scheme/succeed/leftist-heap.ss index b5bf4128..81651f7c 100644 --- a/collects/tests/typed-scheme/succeed/leftist-heap.ss +++ b/collects/tests/typed-scheme/succeed/leftist-heap.ss @@ -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) diff --git a/collects/tests/typed-scheme/succeed/priority-queue.scm b/collects/tests/typed-scheme/succeed/priority-queue.scm index f957d201..bf04a2e4 100644 --- a/collects/tests/typed-scheme/succeed/priority-queue.scm +++ b/collects/tests/typed-scheme/succeed/priority-queue.scm @@ -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 number) top top -> boolean) (lib "67.ss" "srfi")) - ; a priority-queue is a heap of (cons ) +; a priority-queue is a heap of (cons ) (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)]) diff --git a/collects/tests/typed-scheme/succeed/rec-types.ss b/collects/tests/typed-scheme/succeed/rec-types.ss index bcfa6ddc..36e18959 100644 --- a/collects/tests/typed-scheme/succeed/rec-types.ss +++ b/collects/tests/typed-scheme/succeed/rec-types.ss @@ -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!")]))