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

fix parsing of planet paths in executables (merge to 4.2.2)

Browse Source 
svn: r16057
This commit is contained in:
Matthew Flatt 2009-09-17 22:25:36 +00:00
parent 70317a24a8
commit f6cdeb3433
1 changed files with 17 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/compiler/embed-unit.ss
View File

@ -660,16 +660,17 @@
(symbol->string (cadr name)) (symbol->string (cadr name))
(cadr name))]) (cadr name))])
(letrec-values ([(split) (letrec-values ([(split)
(lambda (s rx suffix?) (lambda (s rx suffix-after)
(let-values ([(m) (regexp-match-positions (let-values ([(m) (regexp-match-positions
rx rx
s)]) s)])
(if m (if m
(cons (substring s 0 (caar m)) (cons (substring s 0 (caar m))
(split (substring s (cdar m)) (split (substring s (cdar m))
rx suffix?)) rx
(- suffix-after 1)))
(list (list
(if suffix? (if (suffix-after . <= . 0)
(if (regexp-match? #rx"[.]" s) (if (regexp-match? #rx"[.]" s)
s s
(string-append s ".ss")) (string-append s ".ss"))
@ -684,19 +685,24 @@
(if (null? (cdr l)) (if (null? (cdr l))
null null
(cons (car l) (not-last (cdr l)))))]) (cons (car l) (not-last (cdr l)))))])
(let-values ([(parts) (split s #rx"/" #t)]) (let-values ([(parts) (split s #rx"/" 2)])
(let-values ([(vparts) (split (cadr parts) #rx":" #f)]) (let-values ([(vparts) (split (cadr parts) #rx":" +inf.0)])
(cons 'planet (cons 'planet
(cons (if (null? (cddr parts)) (cons (if (null? (cddr parts))
"main.ss" "main.ss"
(last-of parts)) (last-of parts))
(cons (cons
(cons (car parts) (cons
(cons (string-append (car vparts) (car parts)
".plt") (cons (string-append (car vparts)
;; FIXME: finish version parse: ".plt")
(cdddr parts))) (if (null? (cddr parts))
(not-last (cddr parts))))))))) null
;; FIXME: finish version parse:
(cdddr parts))))
(if (null? (cddr parts))
null
(not-last (cddr parts))))))))))
;; already in long form: ;; already in long form:
name) name)
#f)) #f))