From f2d724cf82d243efa337853086aa2b6e5854792f Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Sat, 21 Feb 2009 15:23:42 +0000
Subject: [PATCH] Type rep compiles

svn: r13768

original commit: 70e174c0e1fbe917d117e36dd9b7b894497fd115
---
 collects/typed-scheme/rep/rep-utils.ss |  3 +-
 collects/typed-scheme/rep/type-rep.ss  | 46 +++++++++++++-------------
 2 files changed, 25 insertions(+), 24 deletions(-)

diff --git a/collects/typed-scheme/rep/rep-utils.ss b/collects/typed-scheme/rep/rep-utils.ss
index ea867648..ebad2a33 100644
--- a/collects/typed-scheme/rep/rep-utils.ss
+++ b/collects/typed-scheme/rep/rep-utils.ss
@@ -108,6 +108,7 @@
               [() (mk #'#f)]
               [(f) (mk #'f)]
               [_ (mk #'(list . flds.fs))]))]
+         [(ign-pats ...) (if key? #'(_ _) #'(_))]
          [frees-def (if #'frees #'frees.def #'(begin))]
          [frees 
           (with-syntax ([(f1 f2) (if #'frees
@@ -132,7 +133,7 @@
               (lambda (s)
                 (syntax-parse s 
                   [(_ . fs) 
-                   #:with pat (syntax/loc s (_ _ . fs))
+                   #:with pat (syntax/loc s (ign-pats ... . fs))
                    (syntax/loc s (struct nm pat))])))
             (begin-for-syntax
               (hash-set! ht-stx 'kw-stx (list #'ex #'flds.fs bfs-fold-rhs #'#,stx)))
diff --git a/collects/typed-scheme/rep/type-rep.ss b/collects/typed-scheme/rep/type-rep.ss
index b837cd14..e6cdd5c5 100644
--- a/collects/typed-scheme/rep/type-rep.ss
+++ b/collects/typed-scheme/rep/type-rep.ss
@@ -320,21 +320,26 @@
       (car l)
       (*Values l)))
 
+(define ((sub-lf st) e)
+  (latentfilter-case (#:Type st
+                      #:LatentFilter (sub-lf st))
+                     e))
 
-#|
 ;; abstract-many : Names Type -> Scope^n 
 ;; where n is the length of names  
 (define (abstract-many names ty)
   (define (nameTo name count type)
     (let loop ([outer 0] [ty type])
       (define (sb t) (loop outer t))
+      (define slf (sub-lf sb))
       (type-case 
-       sb ty
+       (#:Type sb #:LatentFilter (sub-lf sb))
+       ty
        [#:F name* (if (eq? name name*) (*B (+ count outer)) ty)]
        ;; necessary to avoid infinite loops
        [#:Union elems (*Union (remove-dups (sort (map sb elems) type<?)))]
        ;; functions 
-       [#:arr dom rng rest drest kws thn-eff els-eff
+       [#:arr dom rng rest drest kws
               (*arr (map sb dom)
                     (sb rng)
                     (if rest (sb rest) #f)
@@ -342,12 +347,9 @@
                         (cons (sb (car drest))
                               (if (eq? (cdr drest) name) (+ count outer) (cdr drest)))
                         #f)
-                    (for/list ([kw kws])
-                      (cons (car kw) (sb (cdr kw))))
-                    (map (lambda (e) (sub-eff sb e)) thn-eff)
-                    (map (lambda (e) (sub-eff sb e)) els-eff))]
-       [#:ValuesDots tys dty dbound
-              (*ValuesDots (map sb tys)
+                    (map sb kws))]
+       [#:ValuesDots rs dty dbound
+              (*ValuesDots (map sb rs)
                            (sb dty)
                            (if (eq? dbound name) (+ count outer) dbound))]
        [#:Mu (Scope: body) (*Mu (*Scope (loop (add1 outer) body)))]
@@ -371,16 +373,18 @@
 (define (instantiate-many images sc)
   (define (replace image count type)
     (let loop ([outer 0] [ty type])
-      (define (sb t) (loop outer t))
+      (define (sb t) (loop outer t))    
+      (define slf (sub-lf sb))  
       (type-case 
-       sb ty
+       (#:Type sb #:LatentFilter slf)
+       ty
        [#:B idx (if (= (+ count outer) idx)
                     image
                     ty)]      
        ;; necessary to avoid infinite loops
        [#:Union elems (*Union (remove-dups (sort (map sb elems) type<?)))]
        ;; functions
-       [#:arr dom rng rest drest kws thn-eff els-eff
+       [#:arr dom rng rest drest kws
               (*arr (map sb dom)
                     (sb rng)
                     (if rest (sb rest) #f)
@@ -388,12 +392,9 @@
                         (cons (sb (car drest))
                               (if (eqv? (cdr drest) (+ count outer)) (F-n image) (cdr drest)))
                         #f)
-                    (for/list ([kw kws])
-                      (cons (car kw) (sb (cdr kw))))
-                    (map (lambda (e) (sub-eff sb e)) thn-eff)
-                    (map (lambda (e) (sub-eff sb e)) els-eff))]
-       [#:ValuesDots tys dty dbound
-                     (*ValuesDots (map sb tys)
+                    (map sb kws))]
+       [#:ValuesDots rs dty dbound
+                     (*ValuesDots (map sb rs)
                                   (sb dty)                                  
                                   (if (eqv? dbound (+ count outer)) (F-n image) dbound))]
        [#:Mu (Scope: body) (*Mu (*Scope (loop (add1 outer) body)))]
@@ -552,19 +553,19 @@
 (provide
  Mu-name: Poly-names:
  PolyDots-names:
- Type-seq Effect-seq  
+ Type-seq  
  Mu-unsafe: Poly-unsafe:
  PolyDots-unsafe:
  Mu? Poly? PolyDots?
  arr
- Type? Effect?
+ Type? Filter? LatentFilter? Object? LatentObject?
  Poly-n
  PolyDots-n
  free-vars*
  type-equal? type-compare type<?
  remove-dups
- sub-eff
- Values: Values? Values-types
+ sub-lf
+ Values: Values? Values-rs
  (rename-out [Values* make-Values])
  (rename-out [Mu:* Mu:]               
              [Poly:* Poly:]
@@ -578,4 +579,3 @@
 
 ;(trace unfold)
 
-|#
\ No newline at end of file