- '(("boot" :target)
- ("compat" :host)
- ("utils" :both)
- ("numbers" :target)
- ("list" :target)
- ("array" :target)
- ("string" :target)
- ("sequence" :target)
- ("print" :target)
- ("package" :target)
- ("ffi" :target)
- ("misc" :target)
- ("read" :both)
- ("defstruct" :both)
- ("lambda-list" :both)
- ("backquote" :both)
- ("compiler" :both)
- ("toplevel" :target)))
-
-(defun source-pathname
- (filename &key (directory '(:relative "src")) (type nil) (defaults filename))
- (if type
- (make-pathname :type type :directory directory :defaults defaults)
- (make-pathname :directory directory :defaults defaults)))
+ '(("boot" :target)
+ ("compat" :host)
+ ("setf" :target)
+ ("utils" :both)
+ ("numbers" :target)
+ ("char" :target)
+ ("list" :target)
+ ("array" :target)
+ ("string" :target)
+ ("sequence" :target)
+ ("stream" :target)
+ ("hash-table" :target)
+ ("print" :target)
+ ("documentation" :target)
+ ("misc" :target)
+ ("ffi" :target)
+ ("symbol" :target)
+ ("package" :target)
+ ("read" :both)
+ ("defstruct" :both)
+ ("lambda-list" :both)
+ ("backquote" :both)
+ ("compiler"
+ ("codegen" :both)
+ ("compiler" :both))
+ ("toplevel" :target)))
+
+(defun get-files (file-list type dir)
+ "Traverse FILE-LIST and retrieve a list of the files within which match
+ either TYPE or :BOTH, processing subdirectories."
+ (let ((file (car file-list)))
+ (cond
+ ((null file-list)
+ ())
+ ((listp (cadr file))
+ (append
+ (get-files (cdr file) type (append dir (list (car file))))
+ (get-files (cdr file-list) type dir)))
+ ((member (cadr file) (list type :both))
+ (cons (source-pathname (car file) :directory dir :type "lisp")
+ (get-files (cdr file-list) type dir)))
+ (t
+ (get-files (cdr file-list) type dir)))))
+
+(defmacro do-source (name type &body body)
+ "Iterate over all the source files that need to be compiled in the host or
+ the target, depending on the TYPE argument."
+ (unless (member type '(:host :target))
+ (error "TYPE must be one of :HOST or :TARGET, not ~S" type))
+ `(dolist (,name (get-files *source* ,type '(:relative "src")))
+ ,@body))
+
+(defun source-pathname (filename &key (directory '(:relative "src")) (type nil) (defaults filename))
+ (merge-pathnames
+ (if type
+ (make-pathname :type type :directory directory :defaults defaults)
+ (make-pathname :directory directory :defaults defaults))
+ *base-directory*))