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

more fixing redex / undefined interactions

Browse Source
This commit is contained in:
Robby Findler 2014-04-22 22:14:27 -05:00
parent 875fa7bf57
commit 28e9bdcbab
6 changed files with 28 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkgs/redex-pkgs/redex-lib/redex/private/defined-checks.rkt
View File

@ -1,14 +1,7 @@
#lang racket/base
(require "error.rkt"
racket/undefined)
(provide check-defined-lexical
check-defined-module)
(define (check-defined-lexical value name desc)
;; Needed?
(when (eq? undefined value)
(report-undefined name desc)))
(require "error.rkt")
(provide check-defined-module)
(define (check-defined-module thunk name desc)
(with-handlers ([exn:fail:contract:variable?

28
pkgs/redex-pkgs/redex-lib/redex/private/judgment-form.rkt
View File

@ -528,18 +528,22 @@
(define-values (judgment-form-name dup-form-names mode position-contracts clauses rule-names)
(parse-judgment-form-body body syn-err-name stx (identifier? orig) is-relation?))
(define definitions
#`(begin
(define-syntax #,judgment-form-name
(judgment-form '#,judgment-form-name '#,(cdr (syntax->datum mode)) #'judgment-form-runtime-proc
#'mk-judgment-form-proc #'#,lang #'jf-lws
'#,rule-names #'judgment-runtime-gen-clauses #'mk-judgment-gen-clauses #'jf-term-proc #,is-relation?))
(define-values (mk-judgment-form-proc mk-judgment-gen-clauses)
(compile-judgment-form #,judgment-form-name #,mode #,lang #,clauses #,rule-names #,position-contracts
#,orig #,stx #,syn-err-name judgment-runtime-gen-clauses))
(define judgment-form-runtime-proc (mk-judgment-form-proc #,lang))
(define jf-lws (compiled-judgment-form-lws #,clauses #,judgment-form-name #,stx))
(define judgment-runtime-gen-clauses (mk-judgment-gen-clauses #,lang (λ () (judgment-runtime-gen-clauses))))
(define jf-term-proc (make-jf-term-proc #,judgment-form-name #,syn-err-name #,lang #,nts #,mode))))
(with-syntax ([judgment-form-runtime-proc
(syntax-property (syntax/loc judgment-form-name judgment-form-runtime-proc)
'undefined-error-name
(syntax-e judgment-form-name))])
#`(begin
(define-syntax #,judgment-form-name
(judgment-form '#,judgment-form-name '#,(cdr (syntax->datum mode)) #'judgment-form-runtime-proc
#'mk-judgment-form-proc #'#,lang #'jf-lws
'#,rule-names #'judgment-runtime-gen-clauses #'mk-judgment-gen-clauses #'jf-term-proc #,is-relation?))
(define-values (mk-judgment-form-proc mk-judgment-gen-clauses)
(compile-judgment-form #,judgment-form-name #,mode #,lang #,clauses #,rule-names #,position-contracts
#,orig #,stx #,syn-err-name judgment-runtime-gen-clauses))
(define judgment-form-runtime-proc (mk-judgment-form-proc #,lang))
(define jf-lws (compiled-judgment-form-lws #,clauses #,judgment-form-name #,stx))
(define judgment-runtime-gen-clauses (mk-judgment-gen-clauses #,lang (λ () (judgment-runtime-gen-clauses))))
(define jf-term-proc (make-jf-term-proc #,judgment-form-name #,syn-err-name #,lang #,nts #,mode)))))
(syntax-property
(values ;prune-syntax
(if (eq? 'top-level (syntax-local-context))

4
pkgs/redex-pkgs/redex-lib/redex/private/term-fn.rkt
View File

@ -52,8 +52,8 @@
(transformer-predicate defined-term? stx))
(define (defined-check id desc #:external [external id])
(if (eq? (identifier-binding id) 'lexical)
(quasisyntax/loc external (check-defined-lexical #,id '#,external #,desc))
(if (equal? (identifier-binding id) 'lexical)
(datum->syntax id (syntax-e id) external id)
(quasisyntax/loc external (check-defined-module (λ () #,id) '#,external #,desc))))
(define (not-expression-context stx)

9
pkgs/redex-pkgs/redex-lib/redex/private/term.rkt
View File

@ -467,6 +467,9 @@
(syntax-parse stx
[(_ x:id t:expr)
(not-expression-context stx)
#'(begin
(define term-val (term t))
(define-syntax x (defined-term #'term-val)))]))
(with-syntax ([term-val (syntax-property (syntax/loc #'x term-val)
'undefined-error-name
(syntax-e #'x))])
#'(begin
(define term-val (term t))
(define-syntax x (defined-term #'term-val))))]))

2
pkgs/redex-pkgs/redex-test/redex/tests/run-err-tests/judgment-form-undefined.rktd
View File

@ -1,4 +1,4 @@
("reference to judgment form q before its definition"
("q: undefined;\n cannot use before initialization"
([use q]) ([def q])
(let ()
(judgment-holds (use 1))

2
pkgs/redex-pkgs/redex-test/redex/tests/run-err-tests/term.rktd
View File

@ -41,7 +41,7 @@
([rhs 'a]) ([ellipsis ...])
(term-let ([(x ellipsis) rhs]) 3))
("reference to term x before its definition"
("x: undefined;\n cannot use before initialization"
([use x]) ([def x])
(let ()
(define t (term (use y)))