From ab48afda7a62b05b83d0e93e4292e2cb46427b3c Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 7 Mar 2018 13:53:27 -0700
Subject: [PATCH] expander: further repair for implicit-form errors

The previous change didn't report a top-level unbound identifier
correctly.
---
 .../expander/expand/syntax-implicit-error.rkt |   9 +-
 racket/src/racket/src/startup.inc             | 132 +++++++++---------
 2 files changed, 73 insertions(+), 68 deletions(-)

diff --git a/racket/src/expander/expand/syntax-implicit-error.rkt b/racket/src/expander/expand/syntax-implicit-error.rkt
index 0ba08f1224..7eb13d6746 100644
--- a/racket/src/expander/expand/syntax-implicit-error.rkt
+++ b/racket/src/expander/expand/syntax-implicit-error.rkt
@@ -17,6 +17,9 @@
            "reference to a top-level identifier"
            "reference to an unbound identifier")]))
   (define unbound? (and trigger-id (not (resolve trigger-id phase))))
+  (define unbound-form (and unbound?
+                            (not (eq? (syntax-e s) (syntax-e trigger-id)))
+                            s))
   (raise-syntax-error #f
                       (format (if unbound?
                                   "unbound identifier;\n also, no ~a syntax transformer is bound~a"
@@ -27,10 +30,10 @@
                                 [(1) " in the transformer phase"]
                                 [else (format " at phase ~a" phase)]))
                       (and unbound?
-                           (not (eq? (syntax-e s) (syntax-e trigger-id)))
-                           s)
+                           (or unbound-form
+                               trigger-id))
                       (if unbound?
-                          trigger-id
+                          (and unbound-form trigger-id)
                           s)
                       null
                       (if unbound? (syntax-debug-info-string trigger-id ctx) "")))
diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc
index 54f2994d07..0eb3968853 100644
--- a/racket/src/racket/src/startup.inc
+++ b/racket/src/racket/src/startup.inc
@@ -16923,23 +16923,25 @@ static const char *startup_source =
 "(let-values(((trigger-id1_0) trigger-id_0)((phase2_1) phase_44))"
 "(resolve40.1 #f #f #f #f #f #f #f #f trigger-id1_0 phase2_1)))"
 " #f)))"
+"(let-values(((unbound-form_0)"
+"(if unbound?_0(if(not(eq?(syntax-e$1 s_0)(syntax-e$1 trigger-id_0))) s_0 #f) #f)))"
 "(raise-syntax-error$1"
 " #f"
 "(format"
 "(if unbound?_0"
-"                \"unbound identifier;\\n also, no ~a syntax transformer is bound~a\""
-"                (string-append what_1 \" is not allowed;\\n no ~a syntax transformer is bound~a\"))"
+"                  \"unbound identifier;\\n also, no ~a syntax transformer is bound~a\""
+"                  (string-append what_1 \" is not allowed;\\n no ~a syntax transformer is bound~a\"))"
 " sym_27"
 "(let-values(((tmp_17) phase_44))"
 "(if(equal? tmp_17 0)"
-"                  (let-values () \"\")"
+"                    (let-values () \"\")"
 "(if(equal? tmp_17 1)"
-"                    (let-values () \" in the transformer phase\")"
-"                    (let-values () (format \" at phase ~a\" phase_44))))))"
-"(if unbound?_0(if(not(eq?(syntax-e$1 s_0)(syntax-e$1 trigger-id_0))) s_0 #f) #f)"
-"(if unbound?_0 trigger-id_0 s_0)"
+"                      (let-values () \" in the transformer phase\")"
+"                      (let-values () (format \" at phase ~a\" phase_44))))))"
+"(if unbound?_0(let-values(((or-part_13) unbound-form_0))(if or-part_13 or-part_13 trigger-id_0)) #f)"
+"(if unbound?_0(if unbound-form_0 trigger-id_0 #f) s_0)"
 " null"
-"             (if unbound?_0 (syntax-debug-info-string trigger-id_0 ctx_8) \"\"))))))))"
+"               (if unbound?_0 (syntax-debug-info-string trigger-id_0 ctx_8) \"\")))))))))"
 "(define-values(make-check-no-duplicate-table)(lambda()(begin '#hasheq())))"
 "(define-values"
 "(check-no-duplicate-ids8.1)"
@@ -54108,8 +54110,8 @@ static const char *startup_source =
 "(read-char-or-special in_55 special1.1 source_36))))"
 "(let-values(((no-wrap-config_0)(disable-wrapping config_15)))"
 "(let-values(((rx_0)"
-"(let-values(((tmp_17) c3_8))"
-"                          (if (equal? tmp_17 '#\\\")"
+"(let-values(((tmp_55) c3_8))"
+"                          (if (equal? tmp_55 '#\\\")"
 "(let-values()"
 "(let-values((()(begin(accum-string-abandon! accum-str_9 config_15)(values))))"
 "(let-values(((str_31)"
@@ -54119,15 +54121,15 @@ static const char *startup_source =
 " in_5"
 " config_15"
 "(lambda()((if(char=? mode-c_0 '#\\r) regexp pregexp) str_31))))))"
-"(if(equal? tmp_17 '#\\#)"
+"(if(equal? tmp_55 '#\\#)"
 "(let-values()"
 "(let-values((()(begin(accum-string-add! accum-str_9 c3_8)(values))))"
 "(let-values(((c4_2)"
 "(let-values(((in_27) in_5)"
 "((source_37)(read-config-source config_15)))"
 "(read-char-or-special in_27 special1.1 source_37))))"
-"(let-values(((tmp_55) c4_2))"
-"                                      (if (equal? tmp_55 '#\\\")"
+"(let-values(((tmp_56) c4_2))"
+"                                      (if (equal? tmp_56 '#\\\")"
 "(let-values()"
 "(let-values((()"
 "(begin(accum-string-abandon! accum-str_9 config_15)(values))))"
@@ -55102,10 +55104,10 @@ static const char *startup_source =
 "(void))"
 "(values))))"
 "(let-values(((r-config_0)(reading-at(discard-comment config_54) line_12 col_11 pos_124)))"
-"(let-values(((tmp_56) ec_10))"
+"(let-values(((tmp_57) ec_10))"
 "(let-values(((index_4)"
-"(if(char? tmp_56)"
-"(let-values(((codepoint_2)(char->integer tmp_56)))"
+"(if(char? tmp_57)"
+"(let-values(((codepoint_2)(char->integer tmp_57)))"
 "(if(if(unsafe-fx>= codepoint_2 34)(unsafe-fx< codepoint_2 126) #f)"
 "(if(unsafe-fx< codepoint_2 91)"
 "(if(unsafe-fx< codepoint_2 40)"
@@ -55550,10 +55552,10 @@ static const char *startup_source =
 " c3_9)"
 "(let-values()"
 "(let-values()"
-"(let-values(((tmp_57) c_112))"
+"(let-values(((tmp_58) c_112))"
 "(let-values(((index_5)"
-"(if(char? tmp_57)"
-"(let-values(((codepoint_3)(char->integer tmp_57)))"
+"(if(char? tmp_58)"
+"(let-values(((codepoint_3)(char->integer tmp_58)))"
 "(if(if(unsafe-fx>= codepoint_3 33)(unsafe-fx< codepoint_3 127) #f)"
 "(let-values(((tbl_5)"
 " '#(34"
@@ -55987,11 +55989,11 @@ static const char *startup_source =
 "(let-values(((in_73) in_67)"
 "((source_49)(read-config-source config_5)))"
 "(read-char-or-special in_73 special1.1 source_49))))"
-"(let-values(((tmp_58) c2_14))"
-"(if(if(equal? tmp_58 '#\\s) #t(equal? tmp_58 '#\\S))"
+"(let-values(((tmp_59) c2_14))"
+"(if(if(equal? tmp_59 '#\\s) #t(equal? tmp_59 '#\\S))"
 "(let-values()"
 "(read-one #f in_67(override-parameter read-case-sensitive config_5 #t)))"
-"(if(if(equal? tmp_58 '#\\i) #t(equal? tmp_58 '#\\I))"
+"(if(if(equal? tmp_59 '#\\i) #t(equal? tmp_59 '#\\I))"
 "(let-values()"
 "(read-one"
 " #f"
@@ -56030,10 +56032,10 @@ static const char *startup_source =
 "(if(char? c2_15)"
 "(let-values()(accum-string-add! accum-str_12 c2_15))"
 "(void))"
-"(let-values(((tmp_59) c2_15))"
-"(if(equal? tmp_59 '#\\x)"
+"(let-values(((tmp_60) c2_15))"
+"(if(equal? tmp_60 '#\\x)"
 "(let-values()(read-regexp c_112 accum-str_12 in_67 config_5))"
-"(if(equal? tmp_59 '#\\e)"
+"(if(equal? tmp_60 '#\\e)"
 "(let-values()"
 "(read-extension-reader"
 " read-one"
@@ -56072,8 +56074,8 @@ static const char *startup_source =
 "(if(char? c2_16)"
 "(let-values()(accum-string-add! accum-str_13 c2_16))"
 "(void))"
-"(let-values(((tmp_60) c2_16))"
-"(if(equal? tmp_60 '#\\x)"
+"(let-values(((tmp_61) c2_16))"
+"(if(equal? tmp_61 '#\\x)"
 "(let-values()(read-regexp c_112 accum-str_13 in_67 config_5))"
 "(let-values()"
 "(let-values(((in262_0) in_67)"
@@ -56616,10 +56618,10 @@ static const char *startup_source =
 "(let-values(((content63_0)(datum-intern-literal s-exp_4))"
 "((srcloc64_0) srcloc_11)"
 "((props65_0)"
-"(let-values(((tmp_61) rep_1))"
-"(if(equal? tmp_61 '#\\[)"
+"(let-values(((tmp_62) rep_1))"
+"(if(equal? tmp_62 '#\\[)"
 "(let-values() original-square-props)"
-"(if(equal? tmp_61 '#\\{)"
+"(if(equal? tmp_62 '#\\{)"
 "(let-values() original-curly-props)"
 "(let-values() original-props))))))"
 "(syntax1.1"
@@ -61072,11 +61074,11 @@ static const char *startup_source =
 " temp76_3))))"
 "(let-values(((disarmed-exp-body_0)"
 "(syntax-disarm$1 exp-body_0)))"
-"(let-values(((tmp_62)"
+"(let-values(((tmp_63)"
 "(core-form-sym"
 " disarmed-exp-body_0"
 " phase_17)))"
-"(if(equal? tmp_62 'begin)"
+"(if(equal? tmp_63 'begin)"
 "(let-values()"
 "(let-values((()"
 "(begin"
@@ -61178,7 +61180,7 @@ static const char *startup_source =
 " trans-idss_1"
 " stx-clauses_0"
 " dups_0)))))))"
-"(if(equal? tmp_62 'define-values)"
+"(if(equal? tmp_63 'define-values)"
 "(let-values()"
 "(let-values((()"
 "(begin"
@@ -61793,7 +61795,7 @@ static const char *startup_source =
 " trans-idss_1"
 " stx-clauses_0"
 " new-dups_0))))))))))"
-"(if(equal? tmp_62 'define-syntaxes)"
+"(if(equal? tmp_63 'define-syntaxes)"
 "(let-values()"
 "(let-values((()"
 "(begin"
@@ -67934,11 +67936,11 @@ static const char *startup_source =
 "(expand7.1 #f #f #f #f temp437_0 temp438_0))))"
 "(if(expand-context-to-parsed? ctx_102)"
 " exp-e_0"
-"(let-values(((tmp_63)"
+"(let-values(((tmp_64)"
 "(if(not(expand-context-in-local-expand? ctx_102))"
 "(expand-context-context ctx_102)"
 " #f)))"
-"(if(equal? tmp_63 'expression)"
+"(if(equal? tmp_64 'expression)"
 "(let-values()"
 "(let-values(((result-s_13)(syntax-track-origin$1 exp-e_0 rebuild-s_13)))"
 "(begin"
@@ -68055,11 +68057,11 @@ static const char *startup_source =
 " fm_2)"
 " orig-s_61"
 " spec_0)))))))"
-"(let-values(((tmp_64)"
+"(let-values(((tmp_65)"
 " fm_2))"
 "(let-values(((index_7)"
 "(if(symbol?"
-" tmp_64)"
+" tmp_65)"
 "(hash-ref"
 " '#hasheq((all-defined"
 " ."
@@ -68099,7 +68101,7 @@ static const char *startup_source =
 "(struct"
 " ."
 " 6))"
-" tmp_64"
+" tmp_65"
 "(lambda()"
 " 0))"
 " 0)))"
@@ -70696,14 +70698,14 @@ static const char *startup_source =
 " for-loop_81)"
 " lst_79)))"
 "(void)"
-"(let-values(((tmp_65)(cross-phase-primitive-name(parsed-app-rator e_91))))"
-"(if(if(equal? tmp_65 'cons) #t(equal? tmp_65 'list))"
+"(let-values(((tmp_66)(cross-phase-primitive-name(parsed-app-rator e_91))))"
+"(if(if(equal? tmp_66 'cons) #t(equal? tmp_66 'list))"
 "(let-values()(check-count 1 num-results_0 enclosing_15))"
-"(if(equal? tmp_65 'make-struct-type)"
+"(if(equal? tmp_66 'make-struct-type)"
 "(let-values()(check-count 5 num-results_0 enclosing_15))"
-"(if(equal? tmp_65 'make-struct-type-property)"
+"(if(equal? tmp_66 'make-struct-type-property)"
 "(let-values()(check-count 3 num-results_0 enclosing_15))"
-"(if(equal? tmp_65 'gensym)"
+"(if(equal? tmp_66 'gensym)"
 "(let-values()"
 "(if(let-values(((or-part_372)(= 0(length rands_1))))"
 "(if or-part_372"
@@ -70713,7 +70715,7 @@ static const char *startup_source =
 " #f)))"
 "(void)"
 "(let-values()(disallow e_91))))"
-"(if(equal? tmp_65 'string->uninterned-symbol)"
+"(if(equal? tmp_66 'string->uninterned-symbol)"
 "(let-values()"
 "(if(if(= 1(length rands_1))(quoted-string?(car rands_1)) #f)"
 "(void)"
@@ -73326,12 +73328,12 @@ static const char *startup_source =
 "(lambda()"
 "(begin"
 " 'finish"
-"(let-values(((tmp_66)"
+"(let-values(((tmp_67)"
 "(core-form-sym"
 " disarmed-exp-body_1"
 " phase_155)))"
 "(if(equal?"
-" tmp_66"
+" tmp_67"
 " 'begin)"
 "(let-values()"
 "(let-values(((ok?_76"
@@ -73418,7 +73420,7 @@ static const char *startup_source =
 " tail?_52"
 " spliced-bodys_0))))))"
 "(if(equal?"
-" tmp_66"
+" tmp_67"
 " 'begin-for-syntax)"
 "(let-values()"
 "(let-values((()"
@@ -73620,7 +73622,7 @@ static const char *startup_source =
 " tail?_52"
 " rest-bodys_1))))))))))"
 "(if(equal?"
-" tmp_66"
+" tmp_67"
 " 'define-values)"
 "(let-values()"
 "(let-values((()"
@@ -73924,7 +73926,7 @@ static const char *startup_source =
 " tail?_52"
 " rest-bodys_1))))))))))"
 "(if(equal?"
-" tmp_66"
+" tmp_67"
 " 'define-syntaxes)"
 "(let-values()"
 "(let-values((()"
@@ -74487,7 +74489,7 @@ static const char *startup_source =
 " tail?_52"
 " rest-bodys_1)))))))))))))))))"
 "(if(equal?"
-" tmp_66"
+" tmp_67"
 " '#%require)"
 "(let-values()"
 "(let-values((()"
@@ -74628,7 +74630,7 @@ static const char *startup_source =
 " tail?_52"
 " rest-bodys_1)))))))"
 "(if(equal?"
-" tmp_66"
+" tmp_67"
 " '#%provide)"
 "(let-values()"
 "(cons"
@@ -74637,7 +74639,7 @@ static const char *startup_source =
 " tail?_52"
 " rest-bodys_1)))"
 "(if(equal?"
-" tmp_66"
+" tmp_67"
 " 'module)"
 "(let-values()"
 "(let-values(((ready-body_1)"
@@ -74684,7 +74686,7 @@ static const char *startup_source =
 " tail?_52"
 " rest-bodys_1)))))"
 "(if(equal?"
-" tmp_66"
+" tmp_67"
 " 'module*)"
 "(let-values()"
 "(begin"
@@ -74713,7 +74715,7 @@ static const char *startup_source =
 " tail?_52"
 " rest-bodys_1))))"
 "(if(equal?"
-" tmp_66"
+" tmp_67"
 " '#%declare)"
 "(let-values()"
 "(let-values(((ok?_81"
@@ -75294,15 +75296,15 @@ static const char *startup_source =
 "(let-values()"
 "(let-values(((disarmed-body_0)"
 "(syntax-disarm$1 body_24)))"
-"(let-values(((tmp_67)"
+"(let-values(((tmp_68)"
 "(core-form-sym"
 " disarmed-body_0"
 " phase_157)))"
-"(if(if(equal? tmp_67 '#%require)"
+"(if(if(equal? tmp_68 '#%require)"
 " #t"
-"(if(equal? tmp_67 '#%provide)"
+"(if(equal? tmp_68 '#%provide)"
 " #t"
-"(equal? tmp_67 'module*)))"
+"(equal? tmp_68 'module*)))"
 "(let-values() body_24)"
 "(let-values()"
 "(let-values()"
@@ -75582,9 +75584,9 @@ static const char *startup_source =
 "(loop_127(cdr bodys_26) phase_160))))"
 "(let-values()"
 "(let-values(((disarmed-body_1)(syntax-disarm$1(car bodys_26))))"
-"(let-values(((tmp_68)"
+"(let-values(((tmp_69)"
 "(core-form-sym disarmed-body_1 phase_160)))"
-"(if(equal? tmp_68 '#%provide)"
+"(if(equal? tmp_69 '#%provide)"
 "(let-values()"
 "(let-values((()"
 "(begin"
@@ -76077,11 +76079,11 @@ static const char *startup_source =
 "(let-values()"
 "(let-values(((disarmed-body_2)"
 "(syntax-disarm$1 body_25)))"
-"(let-values(((tmp_69)"
+"(let-values(((tmp_70)"
 "(core-form-sym"
 " disarmed-body_2"
 " phase_162)))"
-"(if(equal? tmp_69 'module*)"
+"(if(equal? tmp_70 'module*)"
 "(let-values()"
 "(let-values((()"
 "(begin"
@@ -77063,12 +77065,12 @@ static const char *startup_source =
 "(let-values()"
 "(cons"
 "(let-values()"
-"(let-values(((tmp_70)"
+"(let-values(((tmp_71)"
 "(core-form-sym"
 "(syntax-disarm$1"
 " body_27)"
 " phase_165)))"
-"(if(equal? tmp_70 'module)"
+"(if(equal? tmp_71 'module)"
 "(let-values()"
 "(let-values(((body698_0)"
 " body_27)"