aboutsummaryrefslogtreecommitdiffstats
path: root/requires.scm
blob: cad8db0959800f880461d6a12b25663ba27663ab (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
;;; "require.scm" Trampoline to slib/require.scm

(define library-vicinity
  (let* ((vl (case (software-type)
	       ((AMIGA) '(#\: #\/))
	       ((MS-DOS WINDOWS ATARIST OS/2) '(#\\ #\/))
	       ((MACOS THINKC) '(#\:))
	       ((NOSVE) '(#\: #\.))
	       ((UNIX COHERENT PLAN9) '(#\/))
	       ((VMS) '(#\: #\]))))
	 (iv (implementation-vicinity))
	 (vc (and (positive? (string-length iv))
		  (string-ref iv (+ -1 (string-length iv)))))
	 (vs (if (memv vc vl) (string vc) "/"))
	 (lv (let loop ((pos (+ -2 (string-length iv))))
	       (cond ((or (< pos 0) (not vs))
		      (string-append iv ".." vs "slib" vs))
		     ((memv (string-ref iv pos) vl)
		      (string-append (substring iv 0 (+ 1 pos)) "slib" vs))
		     (else (loop (- pos 1)))))))
    (lambda () lv)))