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

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

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