-
Notifications
You must be signed in to change notification settings - Fork 1
/
ll-load.lisp
81 lines (74 loc) · 1.84 KB
/
ll-load.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
;(defparameter *ROOT-PATH* #P"/Users/l/Code/schemas")
;(setf path-comps (cdr (pathname-directory *load-pathname*)))
;(format t "~s~%" (member "schemas" path-comps :test #'equal))
;(setf path-comps (subseq path-comps 0
; (- (length path-comps) (- (length (member "schemas" path-comps :test #'equal)) 1))))
;(setf path-str "")
;(loop for comp in path-comps
; do (setf path-str (format nil "~a/~a" path-str comp)))
;(format t "root path: ~s~%" path-str)
(if (not (boundp '*LL-LOADED*))
(progn
(declaim (sb-ext:muffle-conditions cl:warning))
(defparameter *LL-LOADED* (make-hash-table :test #'equal))
)
)
(defun ll-load (filename)
(if (gethash filename *LL-LOADED*)
; then
(progn
; (format t "not loading ~s~%" filename)
)
; else
(progn
; (format t "loading ~s~%" filename)
(setf (gethash filename *LL-LOADED*) t)
(load filename)
)
)
)
(defun ll-load-superdir (filename)
(let ((
*default-pathname-defaults*
(make-pathname :directory (reverse (cdr (reverse (pathname-directory *default-pathname-defaults*)))))
))
(if (gethash filename *LL-LOADED*)
; then
(progn
; (format t "not loading ~s~%" filename)
)
; else
(progn
; (format t "loading ~s~%" filename)
(load filename)
(setf (gethash filename *LL-LOADED*) t)
)
)
)
)
(defun ll-load-subdir (subdir filename)
(progn
(let ((*default-pathname-defaults* (pathname (format nil "~a/" (merge-pathnames *default-pathname-defaults* subdir)))))
(if (gethash filename *LL-LOADED*)
; then
(progn
; (format t "not loading ~s~%" filename)
)
; else
(progn
; (format t "loading ~s~%" filename)
(load filename)
(setf (gethash filename *LL-LOADED*) t)
)
)
)
))
(defun clear-ll-load-cache ()
(setf *LL-LOADED* (make-hash-table :test #'equal))
)
(defun cload (filename)
(progn
(clear-ll-load-cache)
(ll-load filename)
)
)