111 lines
3.0 KiB
Scheme
111 lines
3.0 KiB
Scheme
|
#!/usr/bin/scsh -s
|
||
|
|
!#
|
||
|
|
(define targets-prereqs
|
||
|
|
; f : which file to scan
|
||
|
|
; i-dirs : the directories where to look for include files
|
||
|
|
(lambda (f i-dirs)
|
||
|
|
(let ; calling gcc-cmd returns
|
||
|
|
; all dependencies in one entire string
|
||
|
|
((raw-deps (lambda (file dirs)
|
||
|
|
; full command string
|
||
|
|
(let ((gcc-cmd (lambda (my-file ds)
|
||
|
|
; build the include args for gcc e.g.
|
||
|
|
; ("-I." "-I.." "-I/usr/include")
|
||
|
|
(let ((i-args (lambda (d)
|
||
|
|
(let
|
||
|
|
((add-prefix
|
||
|
|
(lambda (p s)
|
||
|
|
(map
|
||
|
|
string-append
|
||
|
|
(circular-list p)
|
||
|
|
s))))
|
||
|
|
(add-prefix "-I" d)))))
|
||
|
|
(append
|
||
|
|
(list "gcc" "-M")
|
||
|
|
(i-args ds)
|
||
|
|
(list my-file))))))
|
||
|
|
(run/string ,(gcc-cmd file dirs)))))
|
||
|
|
; cook-deps returns a list like ("target:" "filename" "otherfile" ...)
|
||
|
|
(cook-deps (lambda (rdeps)
|
||
|
|
(let
|
||
|
|
; merge all \ -separated lines
|
||
|
|
; into one entire line
|
||
|
|
((unbreak-lines (lambda (str)
|
||
|
|
(regexp-substitute/global
|
||
|
|
#f
|
||
|
|
(rx (: (* white)
|
||
|
|
#\\
|
||
|
|
#\newline
|
||
|
|
(* white)))
|
||
|
|
str
|
||
|
|
'pre " " 'post)))
|
||
|
|
; break a string into tokens
|
||
|
|
; "a space delimeted string" ->
|
||
|
|
; ("a" "space" "delimited" "string")
|
||
|
|
(extract-f-l (lambda (s)
|
||
|
|
(string-tokenize s char-set:graphic))))
|
||
|
|
(extract-f-l (unbreak-lines rdeps)))))
|
||
|
|
; splits a list of strings into a target and its prerequisites
|
||
|
|
; by searching for an element with a colon as the last character
|
||
|
|
; returns a pair list and needs the list of dependencies
|
||
|
|
(t-p-pair (lambda (deps-l)
|
||
|
|
(let
|
||
|
|
; deletes the last character colon...
|
||
|
|
((delete-colon (lambda (target)
|
||
|
|
(regexp-substitute/global
|
||
|
|
#f
|
||
|
|
(rx (: #\: eos))
|
||
|
|
target
|
||
|
|
'pre 'post)))
|
||
|
|
; as list-index returns the element no
|
||
|
|
; starting at 0, last-target-element
|
||
|
|
; increases this index by 1
|
||
|
|
(last-target-element
|
||
|
|
(lambda (str-l)
|
||
|
|
; tests if a target-candidate (tc) is a target
|
||
|
|
; a tc is a target if its last character is
|
||
|
|
; a colon...
|
||
|
|
(let ((is-target? (lambda (tc)
|
||
|
|
(regexp-search
|
||
|
|
(rx (: any #\: eos))
|
||
|
|
tc))))
|
||
|
|
(+ 1 (list-index is-target? str-l))))))
|
||
|
|
(cond
|
||
|
|
((null? deps-l) #f)
|
||
|
|
(else
|
||
|
|
(cons
|
||
|
|
; this is a pair list -> the colon can be deleted
|
||
|
|
(map delete-colon
|
||
|
|
(take deps-l (last-target-element deps-l)))
|
||
|
|
(list
|
||
|
|
(drop deps-l (last-target-element deps-l))))))))))
|
||
|
|
(t-p-pair (cook-deps (raw-deps f i-dirs))))))
|
||
|
|
|
||
|
|
(define add-entry
|
||
|
|
(lambda (k d a)
|
||
|
|
(let
|
||
|
|
((tp (lambda (f i)
|
||
|
|
(targets-prereqs f i))))
|
||
|
|
(alist-cons (car (tp k d)) (cdr (tp k d)) a))))
|
||
|
|
|
||
|
|
(define include-dirs
|
||
|
|
(list
|
||
|
|
"./"
|
||
|
|
"/usr/include"
|
||
|
|
"/usr/src/linux/include"))
|
||
|
|
|
||
|
|
(define target-lookup-table
|
||
|
|
(add-entry
|
||
|
|
"./scanme.c"
|
||
|
|
include-dirs
|
||
|
|
'()))
|
||
|
|
|
||
|
|
(define target-lookup-table
|
||
|
|
(add-entry
|
||
|
|
"./it.h"
|
||
|
|
include-dirs
|
||
|
|
target-lookup-table))
|
||
|
|
|
||
|
|
(display target-lookup-table)
|
||
|
|
(newline)
|