; Functions from standard prelude
(define (string-split sep str)
(define (f cs xs) (cons (list->string (reverse cs)) xs))
(let loop ((ss (string->list str)) (cs '()) (xs '()))
(cond ((null? ss) (reverse (if (null? cs) xs (f cs xs))))
((char=? (car ss) sep) (loop (cdr ss) '() (f cs xs)))
(else (loop (cdr ss) (cons (car ss) cs) xs)))))
(define (string-join sep ss)
(define (f s ss)
(string-append s (string sep) ss))
(define (join ss)
(if (null? (cdr ss)) (car ss)
(f (car ss) (join (cdr ss)))))
(if (null? ss) "" (join ss)))
(define-syntax assert
(syntax-rules ()
((assert expr result)
(if (not (equal? expr result))
(for-each
display
`(#\newline "failed assertion:" #\newline
expr #\newline "expected: " ,result
#\newline "returned: " ,expr #\newline))))))
; Helper functions
(define (absolutize-path current-directory path)
(if (char=? #\/ (string-ref path 0))
path
(string-append current-directory "/" path)))
(define (minimize-path path)
(let loop ((in (string-split #\/ path))
(out '()))
(cond ((null? in)
(string-join #\/ (reverse out)))
((string=? ".." (car in))
(loop (cdr in)
(cdr out)))
(else
(let ((x (car in)))
(loop (cdr in)
(cons x out)))))))
; Solution
(define (resolve-path current-directory path)
(minimize-path (absolutize-path current-directory path)))
; Tests
(assert (resolve-path "/a/b/c" "/d/e/f") "/d/e/f")
(assert (resolve-path "/a/b/c" "../d/e") "/a/b/d/e")
(assert (resolve-path "/a/b/c" "../../d/e") "/a/d/e")