suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: use source names in errors about defined identifiers

Browse Source
This commit is contained in:
Matthew Flatt 2019-01-31 10:06:48 -07:00
parent 8b4075bd3d
commit 85edde8132
3 changed files with 51 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
racket/src/cs/linklet.sls
View File

@ -398,7 +398,7 @@
exports-info ; hash(sym -> known) for info about each export; see "known.rkt"
name ; name of the linklet (for debugging purposes)
importss ; list of list of import symbols
exports) ; list of export symbols
exports) ; list of export symbol-or-pair, pair is (cons export-symbol src-symbol)
(nongenerative #{linklet Zuquy0g9bh5vmeespyap4g-1}))
(define (set-linklet-code linklet code preparation)
@ -623,7 +623,7 @@
(linklet-importss linklet))
(define (linklet-export-variables linklet)
(linklet-exports linklet))
(map (lambda (e) (if (pair? e) (car e) e)) (linklet-exports linklet)))
;; ----------------------------------------
@ -634,6 +634,7 @@
(define-record variable (val
name
source-name
constance ; #f (mutable), 'constant, or 'consistent (always the same shape)
inst-box)) ; weak pair with instance in `car`
@ -642,7 +643,7 @@
(define variable-undefined (gensym 'undefined))
(define (make-internal-variable name)
(make-variable variable-undefined name #f (cons #!bwp #f)))
(make-variable variable-undefined name name #f (cons #!bwp #f)))
(define (do-variable-set! var val constance as-define?)
(cond
@ -654,7 +655,7 @@
exn:fail:contract:variable
(string-append "define-values: assignment disallowed;\n"
" cannot re-define a constant\n"
" constant: " (symbol->string (variable-name var)) "\n"
" constant: " (symbol->string (variable-source-name var)) "\n"
" in module:" (variable-module-name var))
(current-continuation-marks)
(variable-name var)))]
@ -662,7 +663,7 @@
(raise
(|#%app|
exn:fail:contract:variable
(string-append (symbol->string (variable-name var))
(string-append (symbol->string (variable-source-name var))
": cannot modify constant")
(current-continuation-marks)
(variable-name var)))])]
@ -731,25 +732,29 @@
[set?
(string-append "set!: assignment disallowed;\n"
" cannot set variable before its definition\n"
" variable: " (symbol->string (variable-name var))
" variable: " (symbol->string (variable-source-name var))
(identify-module var))]
[else
(string-append (symbol->string (variable-name var))
(string-append (symbol->string (variable-source-name var))
": undefined;\n cannot reference undefined identifier"
(identify-module var))])
(current-continuation-marks)
(variable-name var))))
;; Create the variables needed for a linklet's exports
(define (create-variables inst syms)
(define (create-variables inst syms-or-pairs)
(let ([ht (instance-hash inst)]
[inst-box (weak-cons inst #f)])
(map (lambda (sym)
(or (hash-ref ht sym #f)
(let ([var (make-variable variable-undefined sym #f inst-box)])
(hash-set! ht sym var)
var)))
syms)))
(map (lambda (sym-or-pair)
(let-values ([(sym src-sym)
(if (pair? sym-or-pair)
(values (car sym-or-pair) (cdr sym-or-pair))
(values sym-or-pair sym-or-pair))])
(or (hash-ref ht sym #f)
(let ([var (make-variable variable-undefined sym src-sym #f inst-box)])
(hash-set! ht sym var)
var))))
syms-or-pairs)))
(define (variable->known var)
(let ([desc (cdr (variable-inst-box var))])
@ -818,7 +823,8 @@
(cond
[(null? content) (void)]
[else
(hash-set! ht (car content) (make-variable (cadr content) (car content) constance inst-box))
(let ([name (car content)])
(hash-set! ht (car content) (make-variable (cadr content) name name constance inst-box)))
(loop (cddr content))]))
inst)]))
@ -854,7 +860,7 @@
(raise-argument-error 'instance-set-variable-value! "symbol?" i))
(check-constance 'instance-set-variable-value! mode)
(let ([var (or (hash-ref (instance-hash i) k #f)
(let ([var (make-variable variable-undefined k #f (weak-cons i #f))])
(let ([var (make-variable variable-undefined k k #f (weak-cons i #f))])
(hash-set! (instance-hash i) k var)
var))])
(variable-set! var v mode))]))

13
racket/src/schemify/schemify.rkt
View File

@ -6,6 +6,7 @@
"export.rkt"
"struct-type-info.rkt"
"simple.rkt"
"source-sym.rkt"
"find-definition.rkt"
"mutated.rkt"
"mutated-state.rkt"
@ -124,6 +125,9 @@
(if serializable?
(convert-for-serialize bodys #f datum-intern?)
(values bodys null)))
;; Collect source names for define identifiers, to the degree that the source
;; name differs from the
(define src-syms (get-definition-source-syms bodys))
;; Schemify the body, collecting information about defined names:
(define-values (new-body defn-info mutated)
(schemify-body* bodys/constants-lifted prim-knowns imports exports
@ -144,9 +148,12 @@
(for/list ([grp (in-list all-grps)])
(for/list ([im (in-list (import-group-imports grp))])
(import-ext-id im)))
;; Exports (external names):
;; Exports (external names, but paired with source name if it's different):
(for/list ([ex-id (in-list ex-ids)])
(ex-ext-id ex-id))
(define sym (ex-ext-id ex-id))
(define int-sym (ex-int-id ex-id))
(define src-sym (hash-ref src-syms int-sym sym)) ; external name unless 'source-name
(if (eq? sym src-sym) sym (cons sym src-sym)))
;; Import keys --- revised if we added any import groups
(if (null? new-grps)
import-keys
@ -158,7 +165,7 @@
(for/list ([im (in-list (import-group-imports grp))])
(and im-ready?
(known-constant? (import-group-lookup grp (import-ext-id im))))))
;; Convert internal to external identifiers
;; Convert internal to external identifiers for known-value info
(for/fold ([knowns (hasheq)]) ([ex-id (in-list ex-ids)])
(define id (ex-int-id ex-id))
(define v (known-inline->export-known (hash-ref defn-info id #f)

19
racket/src/schemify/source-sym.rkt Normal file
View File

@ -0,0 +1,19 @@
#lang racket/base
(require "match.rkt"
"wrap.rkt")
(provide get-definition-source-syms)
(define (get-definition-source-syms bodys)
(for/fold ([src-syms #hasheq()]) ([body (in-list bodys)])
(match body
[`(define-values ,ids ,rhs)
(for/fold ([src-syms #hasheq()]) ([id (in-list ids)])
(define u-id (unwrap id))
(define sym (or (wrap-property id 'source-name) u-id))
(cond
[(eq? sym u-id) src-syms]
[else (hash-set src-syms u-id sym)]))]
[`,_ src-syms])))