expander: further repair for implicit-form errors

The previous change didn't report a top-level unbound identifier
correctly.
This commit is contained in:
Matthew Flatt 2018-03-07 13:53:27 -07:00
parent 909fed6f2f
commit ab48afda7a
2 changed files with 73 additions and 68 deletions

View File

@ -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) "")))

View File

@ -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)"