Use let/ec instead of let/cc

let/ec: and let/cc:
type for call-with-current-continuation
Start on ImpFilters

svn: r15220

collects/typed-scheme/private/base-env.ss

@@ -275,6 +275,8 @@
 
 [call/cc (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (Un a b)))]
 [call/ec (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (Un a b)))]
+[call-with-current-continuation (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (Un a b)))]
+[call-with-escape-continuation (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (Un a b)))]
 
 [quotient (-Integer -Integer . -> . -Integer)]
 [remainder (-Integer -Integer . -> . -Integer)]

collects/typed-scheme/private/prims.ss

@@ -428,4 +428,14 @@ This file defines two sorts of primitives. All of them are provided into any mod
 (define-syntax (declare-refinement stx)
   (syntax-parse stx
     [(_ p:id)
-     (quasisyntax/loc stx #,(internal #'(declare-refinement-internal p)))]))
+     (quasisyntax/loc stx #,(internal #'(declare-refinement-internal p)))]))
+
+(define-syntaxes (let/cc: let/ec:)
+  (let ()
+    (define ((mk l/c) stx)      
+      (syntax-parse stx
+       #:literals (:)
+       [(_ k:id : t . body)
+	(quasisyntax/loc stx
+   	  (let/cc #,(annotate-names #'([k : t]) stx) . body))]))
+    (values (mk #'let/cc) (mk #'let/ec))))

collects/typed-scheme/private/type-contract.ss

@@ -50,7 +50,7 @@
 
 (define (type->contract ty fail)
   (define vars (make-parameter '()))
-  (let/cc exit
+  (let/ec exit
     (let loop ([ty ty] [pos? #t])
       (define (t->c t) (loop t pos?))
       (define (t->c/neg t) (loop t (not pos?)))

collects/typed-scheme/rep/filter-rep.ss

@@ -7,7 +7,7 @@
   (flat-named-contract
    'Filter
    (λ (e)
-     (and (Filter? e) (not (FilterSet? e))))))
+     (and (Filter? e) (not (NoFilter? e)) (not (FilterSet? e))))))
 
 (define LatentFilter/c
   (flat-named-contract
@@ -31,6 +31,9 @@
 	   (combine-frees (map free-idxs* (cons t p)))]
   [#:fold-rhs (*NotTypeFilter (type-rec-id t) (map pathelem-rec-id p) v)])
 
+;; implication
+(df ImpFilter ([a (listof Filter/c)] [c (listof Filter/c)]))
+
 (df FilterSet (thn els)
      [#:frees (combine-frees (map free-vars* (append thn els)))
 	      (combine-frees (map free-idxs* (append thn els)))]
@@ -64,6 +67,9 @@
   [#:frees (lambda (frees*) (combine-frees (map (compose make-invariant frees*) (cons t p))))]
   [#:fold-rhs (*LNotTypeFilter (type-rec-id t) (map pathelem-rec-id p) idx)])
 
+;; implication
+(df LImpFilter ([a (listof LatentFilter/c)] [c (listof LatentFilter/c)]))
+
 (dlf LFilterSet (thn els)
      [#:frees (combine-frees (map free-vars* (append thn els)))
 	      (combine-frees (map free-idxs* (append thn els)))]

collects/typed-scheme/ts-reference.scrbl

@@ -129,6 +129,11 @@ result of @scheme[_loop] (and thus the result of the entire
 @defform[(let*: ([v : t e] ...) . body)]]]{Type-annotated versions of
 @scheme[letrec] and @scheme[let*].}
 
+@deftogether[[
+@defform[(let/cc: v : t . body)]
+@defform[(let/ec: v : t . body)]]]{Type-annotated versions of
+@scheme[let/cc] and @scheme[let/ec].}
+
 @subsection{Anonymous Functions}
 
 @defform/subs[(lambda: formals . body)

collects/typed-scheme/typecheck/tc-metafunctions.ss

@@ -77,6 +77,10 @@
     [(Bot:) (list (make-LBot))]
     [(TypeFilter: t p (lookup: idx)) (list (make-LTypeFilter t p idx))]
     [(NotTypeFilter: t p (lookup: idx)) (list (make-LNotTypeFilter t p idx))]
+    [(ImpFilter: a c)
+     (match* [(abo a) (abo c)]
+       [((list a*) (list c*)) (list (make-LImpFilter a* c*))]
+       [(_ _) null])]
     [_ null]))
 
 (define (merge-filter-sets fs)
@@ -95,6 +99,12 @@
 (d/c (apo lf s o)
   (-> LatentFilter/c Type/c Object? (or/c '() (list/c Filter/c)))
   (match* (lf s o)
+    [((ImpFilter: as cs) _ _)
+     (match* [(for/list ([a as]) (apo a s o))
+	      (for/list ([c cs]) (apo c s o))]
+       [((list (list a*) ...)
+	 (list (list c*) ...)) (list (make-ImpFilter a* c*))]
+       [(_ _) null])]
     [((LBot:) _ _) (list (make-Bot))]
     [((LNotTypeFilter: (? (lambda (t) (subtype s t)) t) (list) _) _ _) (list (make-Bot))]
     [((LTypeFilter: (? (lambda (t) (not (overlap s t))) t) (list) _) _ _) (list (make-Bot))]
@@ -135,7 +145,13 @@
     [((FilterSet: f1+ f1-) (T-FS:) (FilterSet: f3+ f3-)) (mk (combine null (append f1- f3-)))]
     ;; and
     [((FilterSet: f1+ f1-) (FilterSet: f2+ f2-) (F-FS:)) 
-     (mk (combine (append f1+ f2+) null))]
+     (mk (combine (append f1+ f2+)
+		  null
+		  #;
+		  (append (for/list ([f f1-])
+			    (make-ImpFilter f2+ f))
+			  (for/list ([f f2-])
+			    (make-ImpFilter f1+ f)))))]
     [(f f* f*) (mk f*)]
     ;; the student expansion
     [(f (T-FS:) (F-FS:)) (mk f)]

collects/typed-scheme/types/printer.ss

@@ -15,7 +15,7 @@
 ;; has-name : Type -> Maybe[Symbol]
 (define (has-name? t) 
   (define ns ((current-type-names)))
-  (let/cc return
+  (let/ec return
     (unless print-aliases
       (return #f))
     (for-each