From 78fc0f19e72ee1cc352ac3f4cdd61e69007a7850 Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Wed, 18 Feb 2015 18:53:58 -0500
Subject: [PATCH] Improve types for private field accessors

Enables better occurrence typing for private fields
---
 .../typecheck/check-class-unit.rkt             | 17 ++++++++---------
 typed-racket-test/unit-tests/class-tests.rkt   | 18 ++++++++++++++++++
 2 files changed, 26 insertions(+), 9 deletions(-)

diff --git a/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt b/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
index 9ecfc9c2..476c91ec 100644
--- a/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt
@@ -854,15 +854,14 @@
                         [getter-id (in-list getter-ids)])
       (define maybe-type (dict-ref type-map field-name #f))
       (values
-       (make-Function
-        ;; This case is more complicated than for public fields because private
-        ;; fields support occurrence typing. The object is set as the field's
-        ;; accessor id, so that *its* range type is refined for occurrence typing.
-        (list (make-arr* (list Univ)
-                         (or (and maybe-type (car maybe-type))
-                             Univ)
-                         #:object
-                         (make-Path (list (make-FieldPE)) getter-id))))
+       ;; This case is more complicated than for public fields because private
+       ;; fields support occurrence typing. The object is set as the field's
+       ;; accessor id, so that *its* range type is refined for occurrence typing.
+       (->acc (list Univ)
+              (or (and maybe-type (car maybe-type))
+                  Univ)
+              (list (make-FieldPE))
+              #:var getter-id)
        (-> Univ (or (and maybe-type (car maybe-type)) -Bottom)
            -Void))))
 
diff --git a/typed-racket-test/unit-tests/class-tests.rkt b/typed-racket-test/unit-tests/class-tests.rkt
index 0acc8dc2..2673a636 100644
--- a/typed-racket-test/unit-tests/class-tests.rkt
+++ b/typed-racket-test/unit-tests/class-tests.rkt
@@ -1945,6 +1945,18 @@
                  (if (string? x) (string-append x "bar") "baz"))))
            (send (new c%) m))
          -String]
+   [tc-e (let ()
+           (define c%
+             (class object%
+               (super-new)
+               (: x (U String #f))
+               (define x "foo")
+               (: m (-> String))
+               (define/public (m)
+                 ;; ensure just x works
+                 (if x (string-append x "bar") "baz"))))
+           (send (new c%) m))
+         -String]
    [tc-e (let ()
            (define c%
              (class object%
@@ -1965,6 +1977,12 @@
            ;; let-aliasing + occ. typing on fields
            (let ([y x]) (if (string? y) (string-append x) "")))
          (-class)]
+   [tc-e (class object%
+           (super-new)
+           (: x (Option String))
+           (define x "foo")
+           (let ([y x]) (if y (string-append x) "")))
+         (-class)]
    ;; Failure tests for occurrence typing on private fields. The types
    ;; are obfuscated a bit to prevent interference from type aliases in
    ;; another test.