From b8e3ad16024a693c632383bd478c2e01ad07ad71 Mon Sep 17 00:00:00 2001
From: Stephen Chang <stchang@ccs.neu.edu>
Date: Thu, 10 Mar 2016 16:14:36 -0500
Subject: [PATCH] fix bug with tyvar computation

- define separate ->/test constructor that computes tyvars
  and -> does not because it may be nested
  (see "try" fn in alex.mlish)
- add alex.mlish tests
- other mlish tests still broken --- need to use ->/text
---
 tapl/mlish.rkt                     | 11 ++++++-----
 tapl/tests/mlish/alex.mlish        | 11 +++++++++++
 tapl/tests/run-all-mlish-tests.rkt |  1 +
 3 files changed, 18 insertions(+), 5 deletions(-)
 create mode 100644 tapl/tests/mlish/alex.mlish

diff --git a/tapl/mlish.rkt b/tapl/mlish.rkt
index 66d1e07..640b131 100644
--- a/tapl/mlish.rkt
+++ b/tapl/mlish.rkt
@@ -333,11 +333,12 @@
 
 (define-syntax → ; wrapping →
   (syntax-parser
-    #;[(_ (~and Xs {X:id ...}) . rst)
-     #:when (brace? #'Xs)
-     #:when (with-handlers ([exn:fail:syntax:unbound? (λ (e) (displayln (exn:fail:syntax-exprs e)))])
-              ((current-type-eval) #'(ext-stlc:→ . rst)))
-     #'(∀ (X ...) (ext-stlc:→ . rst))]
+    [(_ . rst) #'(∀ () (ext-stlc:→ . rst))]))
+; special arrow that computes free vars; for use with tests
+; (because we can't write explicit forall
+(provide →/test)
+(define-syntax →/test 
+  (syntax-parser
     [(_ . rst)
      (let L ([Xs #'()]) ; compute unbound ids; treat as tyvars
        (with-handlers ([exn:fail:syntax:unbound?
diff --git a/tapl/tests/mlish/alex.mlish b/tapl/tests/mlish/alex.mlish
new file mode 100644
index 0000000..76a3bde
--- /dev/null
+++ b/tapl/tests/mlish/alex.mlish
@@ -0,0 +1,11 @@
+#lang s-exp "../../mlish.rkt"
+(require "../rackunit-typechecking.rkt")
+
+#;(define (should-err [x : X] [f : (→ X Y)] -> Y)
+  (let ([y (f x)])
+      x))
+
+(define (try [x : X][f : (→ X Y)] → X)
+  (let ([y (f x)]) x))
+
+(check-type try : (→/test X (→ X Y) X))
diff --git a/tapl/tests/run-all-mlish-tests.rkt b/tapl/tests/run-all-mlish-tests.rkt
index 7f29cf1..a7af038 100644
--- a/tapl/tests/run-all-mlish-tests.rkt
+++ b/tapl/tests/run-all-mlish-tests.rkt
@@ -17,3 +17,4 @@
 ;; from rw ocaml
 (require "mlish/term.mlish")
 (require "mlish/find.mlish")
+(require "mlish/alex.mlish")