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

cases for more complicated lexical renames

Browse Source
This commit is contained in:
Blake Johnson 2010-08-03 15:19:30 -06:00 committed by Jay McCarthy
parent 5fa6b1c139
commit b062c900a1
3 changed files with 41 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/compiler/zo-marshal.rkt
View File

@ -271,6 +271,7 @@
(define begin0-sequence-type-num 100) (define begin0-sequence-type-num 100)
(define module-type-num 103) (define module-type-num 103)
(define prefix-type-num 105) (define prefix-type-num 105)
(define free-id-info-type-num 154)
(define-syntax define-enum (define-syntax define-enum
(syntax-rules () (syntax-rules ()
@ -446,6 +447,14 @@
(list->vector stxs))) (list->vector stxs)))
out)])) out)]))
(define (out-free-id-info a-free-id-info out)
(match a-free-id-info
[(struct free-id-info (mpi0 s0 mpi1 s1 p0 p1 p2 insp?))
(out-marshaled
free-id-info-type-num
(vector mpi0 s0 mpi1 s1 p0 p1 p2 insp?)
out)]))
(define-struct module-decl (content)) (define-struct module-decl (content))
(define (out-module mod-form out) (define (out-module mod-form out)
@ -954,6 +963,7 @@
[(prefix? expr) (out-prefix expr out)] [(prefix? expr) (out-prefix expr out)]
[(global-bucket? expr) (out-toplevel expr out)] [(global-bucket? expr) (out-toplevel expr out)]
[(module-variable? expr) (out-toplevel expr out)] [(module-variable? expr) (out-toplevel expr out)]
[(free-id-info? expr) (out-free-id-info expr out)]
[else (out-form expr out)])) [else (out-form expr out)]))
(define (out-value expr out) (define (out-value expr out)

9
collects/compiler/zo-parse.rkt
View File

@ -70,6 +70,11 @@
; XXX Why not leave them as vectors and change the contract? ; XXX Why not leave them as vectors and change the contract?
(make-prefix i (vector->list tv) (vector->list sv))]))) (make-prefix i (vector->list tv) (vector->list sv))])))
(define read-free-id-info
(match-lambda
[(vector mpi0 symbol0 mpi1 symbol1 num0 num1 num2 bool0) ; I have no idea what these mean
(make-free-id-info mpi0 symbol0 mpi1 symbol1 num0 num1 num2 bool0)]))
(define (read-unclosed-procedure v) (define (read-unclosed-procedure v)
(define CLOS_HAS_REST 1) (define CLOS_HAS_REST 1)
(define CLOS_HAS_REF_ARGS 2) (define CLOS_HAS_REF_ARGS 2)
@ -313,6 +318,7 @@
[(100) 'begin0-sequence-type] [(100) 'begin0-sequence-type]
[(103) 'module-type] [(103) 'module-type]
[(105) 'resolve-prefix-type] [(105) 'resolve-prefix-type]
[(154) 'free-id-info-type]
[else (error 'int->type "unknown type: ~e" i)])) [else (error 'int->type "unknown type: ~e" i)]))
(define type-readers (define type-readers
@ -333,7 +339,8 @@
(cons 'case-lambda-sequence-type read-case-lambda) (cons 'case-lambda-sequence-type read-case-lambda)
(cons 'begin0-sequence-type read-sequence) (cons 'begin0-sequence-type read-sequence)
(cons 'module-type read-module) (cons 'module-type read-module)
(cons 'resolve-prefix-type read-resolve-prefix)))) (cons 'resolve-prefix-type read-resolve-prefix)
(cons 'free-id-info-type read-free-id-info))))
(define (get-reader type) (define (get-reader type)
(or (hash-ref type-readers type #f) (or (hash-ref type-readers type #f)

26
collects/compiler/zo-structs.rkt
View File

@ -169,9 +169,27 @@
;; Top-level `require' ;; Top-level `require'
(define-form-struct (req form) ([reqs stx?] [dummy toplevel?])) (define-form-struct (req form) ([reqs stx?] [dummy toplevel?]))
(define-form-struct (lexical-rename wrap) ([bool1 boolean?] ; this needs a name
(define-form-struct free-id-info ([path0 module-path-index?]
[symbol0 symbol?]
[path1 module-path-index?]
[symbol1 symbol?]
[phase0 (or/c exact-integer? #f)]
[phase1 (or/c exact-integer? #f)]
[phase2 (or/c exact-integer? #f)]
[use-current-inspector? boolean?]))
(define-form-struct (lexical-rename wrap) ([has-free-id-renames? boolean?]
[bool2 boolean?] ; this needs a name [bool2 boolean?] ; this needs a name
[alist any/c])) ; should be (listof (cons/c symbol? symbol?)) [alist (listof
(cons/c symbol?
(or/c
symbol?
(cons/c
symbol?
(or/c
(cons/c symbol? (or/c symbol? #f))
free-id-info?)))))]))
(define-form-struct (phase-shift wrap) ([amt exact-integer?] [src (or/c module-path-index? #f)] [dest (or/c module-path-index? #f)])) (define-form-struct (phase-shift wrap) ([amt exact-integer?] [src (or/c module-path-index? #f)] [dest (or/c module-path-index? #f)]))
(define-form-struct (wrap-mark wrap) ([val exact-integer?])) (define-form-struct (wrap-mark wrap) ([val exact-integer?]))
(define-form-struct (prune wrap) ([sym any/c])) (define-form-struct (prune wrap) ([sym any/c]))
@ -179,7 +197,7 @@
(define-form-struct all-from-module ([path module-path-index?] (define-form-struct all-from-module ([path module-path-index?]
[phase (or/c exact-integer? #f)] [phase (or/c exact-integer? #f)]
[src-phase any/c] ; should be (or/c exact-integer? #f) [src-phase any/c] ; should be (or/c exact-integer? #f)
[exceptions (or/c (listof symbol?) #f)] ; should be (listof symbol?) [exceptions (or/c (listof (or/c symbol? number?)) #f)] ; should be (listof symbol?)
[prefix (or/c (vector/c (or/c symbol? #f)) #f)])) ; should be (or/c symbol? #f) [prefix (or/c (vector/c (or/c symbol? #f)) #f)])) ; should be (or/c symbol? #f)
(define-form-struct nominal-path ()) (define-form-struct nominal-path ())
@ -226,3 +244,5 @@