www

commit 88867d867576b68e826acb81aa8ba360e1c349b5
parent 6db8138e58dd22e1151b2b19a2b13e2eaa5aea77
Author: AlexKnauth <alexander@knauth.org>
Date:   Sat,  4 Jun 2016 18:36:56 -0400

improve srcloc information for function applications

Diffstat:
M
tapl/typecheck.rkt
 | 
12
++++++++----

1 file changed, 8 insertions(+), 4 deletions(-)
diff --git a/tapl/typecheck.rkt b/tapl/typecheck.rkt
@@ -326,7 +326,9 @@
                                          (syntax->datum #'o))
                                (current-continuation-marks)))
                       #:with app (datum->syntax #'o '#%app)
-                      #`(app #,(assign-type #'x #'τ) . rst)]
+                      (datum->syntax this-syntax
+                                     (list* #'app (assign-type #'x #'τ) #'rst)
+                                     this-syntax)]
                      #;[(_ . rst) #`(#,(assign-type #'x #'τ) . rst)])
                     #;(make-rename-transformer (assign-type #'x #'τ))] ...)
                   (#%expression e) ... void)))))
@@ -745,9 +747,11 @@
      (syntax-parser
        [(_ lit:id fail-msg:expr)
         #'(~and actual
-                (~fail #:unless (and (identifier? #'actual)
-                                     (free-identifier=? #'actual #'lit))
-                       fail-msg))])))
+                (~parse
+                 (~fail #:unless (and (identifier? #'actual)
+                                      (free-identifier=? #'actual #'lit))
+                        fail-msg)
+                 this-syntax))])))
   (define (merge-type-tags stx)
     (define t (syntax-property stx 'type))
     (or (and (pair? t)