[ create a new paste ] login | about

Link: http://codepad.org/9DxHDkA0    [ raw code | fork ]

fisherro - Scheme, pasted on Aug 9:
; 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")


Output:
No errors or program output.


Create a new paste based on this one


Comments: