added another case for all-from-module renames

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

View File

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

View File

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