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

added another case for all-from-module renames

Browse Source
This commit is contained in:
Blake Johnson 2010-07-28 14:39:01 -06:00 committed by Jay McCarthy
parent 8b195d1c3c
commit 2dfd340031
2 changed files with 24 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -576,12 +576,14 @@
(list* path phase export-name (encode-nominal-path nominal-path) nominal-export-name)]))) (list* path phase export-name (encode-nominal-path nominal-path) nominal-export-name)])))
encoded-bindings) encoded-bindings)
(define (encode-all-from-module all) (define encode-all-from-module
(match all (match-lambda
[(struct all-from-module (path phase src-phase exceptions prefix)) [(struct all-from-module (path phase src-phase (list) #f))
(if (and (empty? exceptions) (not prefix)) (list* path phase src-phase)]
(list* path phase src-phase) [(struct all-from-module (path phase src-phase exns #f))
(list* path phase src-phase (append exceptions prefix)))])) (list* path phase exns src-phase)]
[(struct all-from-module (path phase src-phase exns prefix))
(list* path phase src-phase (append exns prefix))]))
(define (encode-wraps wraps) (define (encode-wraps wraps)
(for/list ([wrap (in-list wraps)]) (for/list ([wrap (in-list wraps)])

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

@ -594,31 +594,22 @@
(make-module-rename phase (make-module-rename phase
(if kind 'marked 'normal) (if kind 'marked 'normal)
set-id set-id
(let ([results (map (lambda (u) (map (local [(define (phase? v)
; u = (list path phase . src-phase) (or (number? v) (not v)))]
; or u = (list path phase src-phase exn ... . prefix) (match-lambda
(let ([just-phase? (let ([v (cddr u)]) [(list* path (? phase? phase) (? phase? src-phase) exn ... prefix)
(or (number? v) (not v)))])
(let-values ([(exns prefix)
(if just-phase?
(values null #f)
(let loop ([u (if just-phase? null (cdddr u))]
[a null])
(if (pair? u)
(loop (cdr u) (cons (car u) a))
(values (reverse a) u))))])
(make-all-from-module (make-all-from-module
(parse-module-path-index cp (car u)) (parse-module-path-index cp path)
(cadr u) phase src-phase exn prefix)]
(if just-phase? [(list* path (? phase? phase) (list exn ...) (? phase? src-phase))
(cddr u) (make-all-from-module
(caddr u)) (parse-module-path-index cp path)
exns phase src-phase exn #f)]
prefix)))) [(list* path (? phase? phase) (? phase? src-phase))
unmarshals)]) (make-all-from-module
#;(printf "~nunmarshals: ~S~n" unmarshals) (parse-module-path-index cp path)
#;(printf "~nunmarshal results: ~S~n" results) phase src-phase empty #f)]))
results) unmarshals)
(decode-renames renames) (decode-renames renames)
mark-renames mark-renames
(and plus-kern? 'plus-kern)))] (and plus-kern? 'plus-kern)))]