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

fix zo-parse, zo-struct, etc. for context in whole-module import

Browse Source 
original commit: 6173b7eb05
This commit is contained in:
Matthew Flatt 2012-06-23 05:21:08 -07:00
parent fd364dc2de
commit 359eb87abb
3 changed files with 22 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -406,11 +406,13 @@
(define (encode-all-from-module afm) (define (encode-all-from-module afm)
(match afm (match afm
[(struct all-from-module (path phase src-phase #f #f)) [(struct all-from-module (path phase src-phase null #f null))
(list* path phase src-phase)] (list* path phase src-phase)]
[(struct all-from-module (path phase src-phase exns #f)) [(struct all-from-module (path phase src-phase null #f context))
(list* path phase context src-phase)]
[(struct all-from-module (path phase src-phase exns #f null))
(list* path phase exns src-phase)] (list* path phase exns src-phase)]
[(struct all-from-module (path phase src-phase exns (vector prefix))) [(struct all-from-module (path phase src-phase exns prefix null))
(list* path phase src-phase exns prefix)])) (list* path phase src-phase exns prefix)]))
(define (encode-wraps wraps) (define (encode-wraps wraps)

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

@ -694,25 +694,31 @@
[else (error 'parse "bad phase shift: ~e" a)])] [else (error 'parse "bad phase shift: ~e" a)])]
[else (error 'decode-wraps "bad wrap element: ~e" a)]))) [else (error 'decode-wraps "bad wrap element: ~e" a)])))
(define (afm-context? v)
(or (and (list? v) (andmap exact-integer? v))
(and (vector? v)
(= 2 (vector-length v))
(list? (vector-ref v 0))
(andmap exact-integer? (vector-ref v 0)))))
(define all-from-module-memo (make-memo)) (define all-from-module-memo (make-memo))
(define (decode-all-from-module cp afm) (define (decode-all-from-module cp afm)
(define (phase? v) (define (phase? v)
(or (number? v) (not v))) (or (number? v) (not v)))
(with-memo all-from-module-memo afm (with-memo all-from-module-memo afm
(match afm (match afm
[(list* path (? phase? phase) (? phase? src-phase) [(list* path (? phase? phase) (? phase? src-phase) (list exn ...) prefix)
(list exn ...) prefix)
(make-all-from-module (make-all-from-module
(parse-module-path-index cp path) (parse-module-path-index cp path)
phase src-phase exn (vector prefix))] phase src-phase exn prefix null)]
[(list* path (? phase? phase) (list exn ...) (? phase? src-phase)) [(list* path (? phase? phase) (? afm-context? context) (? phase? src-phase))
(make-all-from-module (make-all-from-module
(parse-module-path-index cp path) (parse-module-path-index cp path)
phase src-phase exn #f)] phase src-phase null #f context)]
[(list* path (? phase? phase) (? phase? src-phase)) [(list* path (? phase? phase) (? phase? src-phase))
(make-all-from-module (make-all-from-module
(parse-module-path-index cp path) (parse-module-path-index cp path)
phase src-phase #f #f)]))) phase src-phase null #f null)])))
(define wraps-memo (make-memo)) (define wraps-memo (make-memo))
(define (decode-wraps cp w) (define (decode-wraps cp w)

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

@ -202,9 +202,11 @@
(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 (or/c exact-integer? #f)]
[exceptions (or/c (listof (or/c symbol? number?)) #f)] ; should be (listof symbol?) [exceptions (listof symbol?)]
[prefix (or/c (vector/c (or/c symbol? #f)) #f)])) ; should be (or/c symbol? #f) [prefix (or/c symbol? #f)]
[context (or/c (listof exact-integer?)
(vector/c (listof exact-integer?) any/c))]))
(define-form-struct nominal-path ()) (define-form-struct nominal-path ())
(define-form-struct (simple-nominal-path nominal-path) ([value module-path-index?])) (define-form-struct (simple-nominal-path nominal-path) ([value module-path-index?]))