Sync
Signed-off-by: Jacob Hrbek <kreyren@rixotstudio.cz>
This commit is contained in:
parent
ddb3640fb8
commit
6a8b09699e
GPG Key ID:
667F0DAFAF09BA2B
23
TAGS.org
Normal file
23
TAGS.org
Normal file
@ -0,0 +1,23 @@
|
||||
#+TITLE: TAGS
|
||||
|
||||
This project is tagging code using the following syntax:
|
||||
|
||||
#+BEGIN_SRC scheme-mode
|
||||
;; MAIN_TAG-SUB_TAG(Tag Author Signature): Comment
|
||||
#+END_SRC
|
||||
|
||||
Which in practice might be used as:
|
||||
|
||||
#+BEGIN_SRC scheme-mode
|
||||
;; FIXME-QA(Krey): This code needs to be improved for whatever reason
|
||||
(some (scheme (code)))
|
||||
#+END_SRC
|
||||
|
||||
** List of Tags
|
||||
|
||||
- FIXME = Used to tag code that needs attention
|
||||
- FIXME-QA = Used to tag code with Quality Assurance issues
|
||||
- FIXME-DOCS = Tags code that needs documentation
|
||||
- DNR = Do Not Release - Usage prevents new version release, used to tag code that needs to be addressed prior
|
||||
- DNM = Do Not Merge - Usage in merge/pull requests blocks syncing the code, used to tag code that needs to be addressed before merge can happen
|
||||
- PROD/PRODUCTION = Code that should be considered prior to it's usage in production environment
|
||||
@ -38,16 +38,14 @@
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; DOCS
|
||||
;;; Backend code used for the parsing of non-guile makefiles
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define (read-line-handle-escaped-newline)
|
||||
"Reads a line of text from the current input port.
|
||||
|
||||
If the line ends with an odd number of backslashes, the following line
|
||||
is read and appended. The output string has newlines as line
|
||||
terminators.
|
||||
If the line ends with an odd number of backslashes, the following line is read and appended. The output string has newlines as line terminators.
|
||||
|
||||
It returns two values
|
||||
- the string containing the one or more lines read
|
||||
@ -65,10 +63,7 @@ It returns two values
|
||||
(values (string-append output line "\n") (1+ nline)))))))
|
||||
|
||||
(define* (string-collapse-continuations str #:optional (squash-whitespace? #f))
|
||||
"Returns a new string where backslash+newline is discarded, and
|
||||
backslash+backslash+newline becomes backslash+newline. Any whitespace
|
||||
after the newline may be squashed to a single space, if
|
||||
squash-whitespace? is #t."
|
||||
"Returns a new string where backslash+newline is discarded, and backslash+backslash+newline becomes backslash+newline. Any whitespace after the newline may be squashed to a single space, if squash-whitespace? is #t."
|
||||
(let loop ((str str)
|
||||
(newline-index (string-rindex str #\newline)))
|
||||
(if (not newline-index)
|
||||
|
||||
@ -27,15 +27,18 @@
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; DOCS
|
||||
;;; Functionality to parse non-guile makefiles
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
;; A makefile can contain rules, macro definitions, include lines, and comments.
|
||||
|
||||
;; FIXME-DOCS(Krey)
|
||||
(define (parse filename)
|
||||
(with-input-from-file filename _eval #:guess-encoding #t))
|
||||
|
||||
;; DNM-SECURITY(Krey): Check very carefully
|
||||
;; FIXME-DOCS(Krey)
|
||||
(define (_eval)
|
||||
(let ((filenames #f)
|
||||
(ignoring #f)
|
||||
@ -62,7 +65,7 @@
|
||||
(newline)))))))
|
||||
|
||||
(define (string-parse-variable-definition str i)
|
||||
"Parse a string as a variable definition."
|
||||
"Parse a string as a variable definition"
|
||||
(let loop ((i (string-next-token str)))
|
||||
(cond
|
||||
((= i (string-length str))
|
||||
@ -117,6 +120,8 @@
|
||||
(values i 'null)))))))
|
||||
(else
|
||||
(values i 'null)))))
|
||||
|
||||
;; STUB(Krey): Unfinished code by original author, kept here in case we need to finish it in the future
|
||||
#|
|
||||
(define (parse-var-assignment line)
|
||||
(let ((i (string-next-token line 0)))
|
||||
@ -124,5 +129,6 @@
|
||||
#f
|
||||
;; else
|
||||
(while #t
|
||||
|
||||
|#
|
||||
|
||||
;;; parse.scm ends here
|
||||
|
||||
@ -25,16 +25,25 @@
|
||||
#:use-module (potato text)
|
||||
#:export (parse))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; Core functionality of the parsed for non-guile makefiles
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
;; A makefile can contain rules, macro definitions, include lines,
|
||||
;; and comments.
|
||||
|
||||
(define (parse filename)
|
||||
"FIXME-DOCS"
|
||||
(with-input-from-file filename parse-input #:guess-encoding #t))
|
||||
|
||||
(define (last-char str)
|
||||
"FIXME-DOCS"
|
||||
(string-ref str (1- (string-length str))))
|
||||
|
||||
(define (parse-input)
|
||||
"FIXME-DOCS"
|
||||
(while #t
|
||||
(let loop ((line "")
|
||||
(str (read-line)))
|
||||
@ -68,8 +77,8 @@
|
||||
(define-peg-pattern COMMENT none (or C_COMMENT
|
||||
(and (+ C_SPACE) (not-followed-by peg-any))))
|
||||
|
||||
|
||||
(define (parse-line line)
|
||||
"FIXME-DOCS"
|
||||
(write (peg:tree (match-pattern INCLUDE line)))
|
||||
(newline)
|
||||
(write (peg:tree (match-pattern COMMENT line)))
|
||||
@ -90,17 +99,18 @@
|
||||
(else
|
||||
(format #t "UNKNOWN: ~S~%" line))))
|
||||
|
||||
|
||||
|
||||
(define (line-is-include? line)
|
||||
"FIXME-DOCS"
|
||||
(and (> (string-length line) 8)
|
||||
(string= line "include " 0 8)))
|
||||
|
||||
(define (line-is-comment? line)
|
||||
"FIXME-DOCS"
|
||||
(or (string-null? (string-trim-both line char-set:whitespace))
|
||||
(char=? (string-ref line 0) #\#)))
|
||||
|
||||
(define (line-is-macro? line)
|
||||
"FIXME-DOCS"
|
||||
(let ((len (string-length line)))
|
||||
(let loop ((i 0))
|
||||
(if (>= i len)
|
||||
@ -120,6 +130,7 @@
|
||||
(loop (+ i 1)))))))))
|
||||
|
||||
(define (line-is-special-target? line)
|
||||
"FIXME-DOCS"
|
||||
(or (and (>= (string-length line) 8)
|
||||
(string= line ".DEFAULT" 0 8))
|
||||
(and (>= (string-length line) 8)
|
||||
@ -134,6 +145,7 @@
|
||||
(string= line ".SILENT" 0 7))))
|
||||
|
||||
(define (line-is-rule? line)
|
||||
"FIXME-DOCS"
|
||||
(let ((len (string-length line)))
|
||||
(let loop ((i 0))
|
||||
(if (>= i len)
|
||||
@ -153,6 +165,7 @@
|
||||
(loop (+ i 1)))))))))
|
||||
|
||||
(define (line-is-inference-rule? line)
|
||||
"FIXME-DOCS"
|
||||
(let ((len (string-length line)))
|
||||
(let loop ((i 0)
|
||||
(dot-count 0))
|
||||
@ -180,6 +193,7 @@
|
||||
0))))))))))
|
||||
|
||||
(define (char-is-pcs? c)
|
||||
"FIXME-DOCS"
|
||||
(or (and (char<=? #\a c) (char>=? #\z c))
|
||||
(and (char<=? #\A c) (char>=? #\Z c))
|
||||
(and (char<=? #\0 c) (char>=? #\9 c))
|
||||
@ -187,6 +201,8 @@
|
||||
(char=? #\_ c)))
|
||||
|
||||
(define (char-is-pcs-or-space? c)
|
||||
"FIXME-DOCS"
|
||||
(or (char-is-pcs? c)
|
||||
(char=? #\space c)))
|
||||
|
||||
;;; parser.scm ends here
|
||||
|
||||
@ -42,24 +42,26 @@
|
||||
string-compose ~
|
||||
silent-compose ~@
|
||||
always-execute-compose ~+
|
||||
ignore-error-compose ~-
|
||||
))
|
||||
ignore-error-compose ~-))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; Dedicated to logic processing of rules/tasks
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; GLOBALS
|
||||
|
||||
(define %ignore-errors? #f)
|
||||
(define %continue-on-error? #f)
|
||||
(define %no-execution? #f)
|
||||
(define %verbosity 2)
|
||||
(define %ascii? #f)
|
||||
(define %top-level-targets '())
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; HELPER FUNCTIONS
|
||||
;; FIXME-QA(Krey): Should be re-structured so that the function that are just making aliases to procedures have their own section for easier navigation
|
||||
;; FIXME-QA/PROD(Krey): Doesn't seem to have a robust code and is using lot of functions that have potential for infinite loops, should be considered prior to deployment into a production environment
|
||||
|
||||
;;; GLOBALS
|
||||
(define %ignore-errors? #f) ;; FIXME-QA/DOCS(Krey): What is this variable used for?
|
||||
(define %continue-on-error? #f) ;; FIXME-QA/DOCS(Krey): What is this variable used for?
|
||||
(define %no-execution? #f) ;; FIXME-QA/DOCS(Krey): What is this variable used for?
|
||||
(define %verbosity 2) ;; FIXME-QA/DOCS(Krey): What is this variable used for?
|
||||
(define %ascii? #f) ;; FIXME-QA/DOCS(Krey): What is this variable used for?
|
||||
(define %top-level-targets '()) ;; FIXME-QA/DOCS(Krey): What is this variable used for?
|
||||
|
||||
;;; HELPER FUNCTIONS
|
||||
(define (basename str)
|
||||
"Strip off the '.ext' part of a filename string."
|
||||
(unless (string? str)
|
||||
@ -71,12 +73,9 @@
|
||||
str)))
|
||||
|
||||
(define (base-compose . args)
|
||||
"Returns a lambda that appends args together as a string,
|
||||
adding intermediate spaces. If an arg is a procedure,
|
||||
it is evaluated."
|
||||
"Returns a lambda that appends args together as a string, adding intermediate spaces. If an arg is a procedure, it is evaluated."
|
||||
(lambda ()
|
||||
;; Loop over all the args, appending them together as a
|
||||
;; string. Try to be smart about the types of args.
|
||||
;; Loop over all the args, appending them together as a string. Try to be smart about the types of args.
|
||||
(let loop ((args args)
|
||||
(result ""))
|
||||
(cond
|
||||
@ -95,8 +94,7 @@ it is evaluated."
|
||||
((string? arg)
|
||||
(set! effective-arg arg))
|
||||
(else
|
||||
;; Not a string or procedure?
|
||||
;; Let's just write it, I guess. YOLO!
|
||||
;; NOTE(spk121): Not a string or procedure? Let's just write it, I guess. YOLO!
|
||||
(set! effective-arg
|
||||
(format #f "~a" arg))))
|
||||
|
||||
@ -112,26 +110,31 @@ it is evaluated."
|
||||
effective-arg)))))))))
|
||||
|
||||
(define (string-compose . args)
|
||||
"FIXME-DOCS"
|
||||
(cons 'default (apply base-compose args)))
|
||||
|
||||
(define ~ string-compose)
|
||||
|
||||
(define (ignore-error-compose . args)
|
||||
"FIXME-DOCS"
|
||||
(cons 'ignore-error (apply base-compose args)))
|
||||
|
||||
(define ~- ignore-error-compose)
|
||||
|
||||
(define (silent-compose . args)
|
||||
"FIXME-DOCS"
|
||||
(cons 'silent (apply base-compose args)))
|
||||
|
||||
(define ~@ silent-compose)
|
||||
|
||||
(define (always-execute-compose . args)
|
||||
"FIXME-DOCS"
|
||||
(cons 'always-execute (apply base-compose args)))
|
||||
|
||||
(define ~+ always-execute-compose)
|
||||
|
||||
(define (regular-file? filename)
|
||||
"FIXME-DOCS"
|
||||
(unless (string? filename)
|
||||
(scm-error 'wrong-type-arg "regular-file?" "Not a string: ~S" (list filename) #f))
|
||||
|
||||
@ -139,6 +142,7 @@ it is evaluated."
|
||||
(eq? (stat:type st) 'regular)))
|
||||
|
||||
(define (compute-mtime filename)
|
||||
"FIXME-DOCS"
|
||||
(unless (string? filename)
|
||||
(scm-error 'wrong-type-arg "regular-file?" "Not a string: ~S" (list filename) #f))
|
||||
|
||||
@ -146,19 +150,18 @@ it is evaluated."
|
||||
(+ (* 1000000000 (stat:mtime st))
|
||||
(stat:mtimensec st))))
|
||||
|
||||
;; FIXME-DOCS/QA(Krey): What is this doing?
|
||||
(define %system-proc system)
|
||||
|
||||
(define (install-alternate-system-driver proc)
|
||||
"Give a procure to use rather than the standard 'system' procedure,
|
||||
installs it as the system driver. Returns the old system driver."
|
||||
"Give a procure to use rather than the standard 'system' procedure, installs it as the system driver. Returns the old system driver."
|
||||
(unless (procedure? proc)
|
||||
(scm-error 'wrong-type-arg "install-alternate-system-driver" "Not a procedure: ~S" (list proc) #f))
|
||||
(let ((old-proc %system-proc))
|
||||
(set! %system-proc proc)
|
||||
old-proc))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; TARGET STRUCT AND METHODS
|
||||
;;; TARGET STRUCT AND METHODS
|
||||
|
||||
(define-record-type <target-rule>
|
||||
(make-target-rule name prerequisites recipes priority)
|
||||
@ -190,8 +193,7 @@ installs it as the system driver. Returns the old system driver."
|
||||
(when (null? recipes)
|
||||
(set! recipes (list #t)))
|
||||
|
||||
;; If any recipes are raw strings, we need to make them into
|
||||
;; (cons 'default string)
|
||||
;; NOTE(spk121): If any recipes are raw strings, we need to make them into `(cons 'default string)`
|
||||
(let ((recipes2
|
||||
(map (lambda (recipe)
|
||||
(cond
|
||||
@ -214,8 +216,7 @@ installs it as the system driver. Returns the old system driver."
|
||||
;; else
|
||||
(target-rule-get-name (last %target-rules))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SUFFIX STRUCT AND METHODS
|
||||
;;; SUFFIX STRUCT AND METHODS
|
||||
|
||||
(define-record-type <suffix-rule>
|
||||
(make-suffix-rule source-suffix target-suffix recipes priority)
|
||||
@ -239,13 +240,12 @@ installs it as the system driver. Returns the old system driver."
|
||||
(define (suffix-rule source target . recipes)
|
||||
"Register a suffix rule"
|
||||
|
||||
;; FIXME: Typecheck
|
||||
;; FIXME(spk121): Typecheck
|
||||
(when (>= %verbosity 3)
|
||||
(format #t "Suffix rule: ~a~A~a ~A ~a~A~a~%~!"
|
||||
(lquo) source (rquo) (right-arrow) (lquo) target (rquo)))
|
||||
|
||||
;; If any recipes are raw strings, we need to make them into
|
||||
;; (cons 'default string)
|
||||
;; NOTE(spk121): If any recipes are raw strings, we need to make them into `(cons 'default string)`
|
||||
(let ((recipes2
|
||||
(map (lambda (recipe)
|
||||
(cond
|
||||
@ -261,8 +261,7 @@ installs it as the system driver. Returns the old system driver."
|
||||
;; Alias
|
||||
(define -> suffix-rule)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; NODE STRUCT AND METHODS
|
||||
;;; NODE STRUCT AND METHODS
|
||||
|
||||
(define-record-type <node>
|
||||
(make-node name parent status)
|
||||
@ -282,35 +281,44 @@ installs it as the system driver. Returns the old system driver."
|
||||
(rule-type node-get-rule-type node-set-rule-type!)
|
||||
;; A list of rules
|
||||
(rules node-get-rules node-set-rules!)
|
||||
(children node-get-children node-set-children!)
|
||||
)
|
||||
(children node-get-children node-set-children!))
|
||||
|
||||
(define (using-target-rule? node)
|
||||
"FIXME-DOCS"
|
||||
(eq? 'target (node-get-rule-type node)))
|
||||
(define (using-suffix-rules? node)
|
||||
"FIXME-DOCS"
|
||||
(eq? 'suffix (node-get-rule-type node)))
|
||||
(define (using-default-rule? node)
|
||||
"FIXME-DOCS"
|
||||
(eq? 'default (node-get-rule-type node)))
|
||||
|
||||
(define (set-fail! node)
|
||||
"FIXME-DOCS"
|
||||
(node-set-status! node 'fail))
|
||||
|
||||
(define (set-pass! node)
|
||||
"FIXME-DOCS"
|
||||
(node-set-status! node 'pass))
|
||||
|
||||
(define (failed? node)
|
||||
"FIXME-DOCS"
|
||||
(eqv? (node-get-status node) 'fail))
|
||||
|
||||
(define (passed? node)
|
||||
"FIXME-DOCS"
|
||||
(eqv? (node-get-status node) 'pass))
|
||||
|
||||
(define (leaf-node? node)
|
||||
"FIXME-DOCS"
|
||||
(null? (node-get-children node)))
|
||||
|
||||
(define (undetermined? node)
|
||||
"FIXME-DOCS"
|
||||
(eq? (node-get-status node) 'undetermined))
|
||||
|
||||
(define (any-child-has-passed? node)
|
||||
"FIXME-DOCS"
|
||||
(unless (node? node)
|
||||
(scm-error 'wrong-type-arg "any-child-has-passed?" "Not a node: ~S" (list node) #f))
|
||||
(when (null? (node-get-children node))
|
||||
@ -321,6 +329,7 @@ installs it as the system driver. Returns the old system driver."
|
||||
(any passed? children)))
|
||||
|
||||
(define (every-child-has-passed? node)
|
||||
"FIXME-DOCS"
|
||||
(unless (node? node)
|
||||
(scm-error 'wrong-type-arg "every-child-has-passed?" "Not a node: ~S" (list node) #f))
|
||||
(when (null? (node-get-children node))
|
||||
@ -331,6 +340,7 @@ installs it as the system driver. Returns the old system driver."
|
||||
(every passed? children)))
|
||||
|
||||
(define (any-child-has-failed? node)
|
||||
"FIXME-DOCS"
|
||||
(unless (node? node)
|
||||
(scm-error 'wrong-type-arg "any-child-has-failed?" "Not a node: ~S" (list node) #f))
|
||||
(when (null? (node-get-children node))
|
||||
@ -341,6 +351,7 @@ installs it as the system driver. Returns the old system driver."
|
||||
(any failed? children)))
|
||||
|
||||
(define (every-child-has-failed? node)
|
||||
"FIXME-DOCS"
|
||||
(unless (node? node)
|
||||
(scm-error 'wrong-type-arg "every-child-has-failed?" "Not a node: ~S" (list node) #f))
|
||||
(when (null? (node-get-children node))
|
||||
@ -351,6 +362,7 @@ installs it as the system driver. Returns the old system driver."
|
||||
(every failed? children)))
|
||||
|
||||
(define (children-complete? node)
|
||||
"FIXME-DOCS"
|
||||
(cond
|
||||
((leaf-node? node)
|
||||
#t)
|
||||
@ -364,6 +376,7 @@ installs it as the system driver. Returns the old system driver."
|
||||
#f)))
|
||||
|
||||
(define (children-passed? node)
|
||||
"FIXME-DOCS"
|
||||
(cond
|
||||
((null? (node-get-children node))
|
||||
#t)
|
||||
@ -388,16 +401,19 @@ installs it as the system driver. Returns the old system driver."
|
||||
children)))))
|
||||
|
||||
(define (has-parent? node)
|
||||
"FIXME-DOCS"
|
||||
(if (node-get-parent node)
|
||||
#t
|
||||
#f))
|
||||
|
||||
(define (has-children? node)
|
||||
"FIXME-DOCS"
|
||||
(if (null? (node-get-children node))
|
||||
#f
|
||||
#t))
|
||||
|
||||
(define (get-parent node)
|
||||
"FIXME-DOCS"
|
||||
(node-get-parent node))
|
||||
|
||||
(define (up-to-date? node)
|
||||
@ -420,6 +436,7 @@ installs it as the system driver. Returns the old system driver."
|
||||
#f)))))
|
||||
|
||||
(define (node-depth node)
|
||||
"FIXME-DOCS"
|
||||
(let loop ((depth 0)
|
||||
(cur node))
|
||||
(if (has-parent? cur)
|
||||
@ -430,14 +447,13 @@ installs it as the system driver. Returns the old system driver."
|
||||
(define (node-depth-string node)
|
||||
(make-string (* 2 (node-depth node)) #\space))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; AUTOMATIC VARIABLES
|
||||
|
||||
(define target-name 'unspecified)
|
||||
(define target-basename 'unspecified)
|
||||
(define prerequisites '())
|
||||
(define primary-prerequisite 'unspecified)
|
||||
(define newer-prerequisites '())
|
||||
(define target-name 'unspecified) ;; FIXME-DOCS(Krey): What is this variable doing?
|
||||
(define target-basename 'unspecified) ;; FIXME-DOCS(Krey): What is this variable doing?
|
||||
(define prerequisites '()) ;; FIXME-DOCS(Krey): What is this variable doing?
|
||||
(define primary-prerequisite 'unspecified) ;; FIXME-DOCS(Krey): What is this variable doing?
|
||||
(define newer-prerequisites '()) ;; FIXME-DOCS(Krey): What is this variable doing?
|
||||
|
||||
(define (string-append-with-spaces lst)
|
||||
"Appends the strings in lst, adding spaces in between."
|
||||
@ -450,6 +466,7 @@ installs it as the system driver. Returns the old system driver."
|
||||
(car lst)
|
||||
(cdr lst))))
|
||||
|
||||
;; Aliases
|
||||
(define $@ (lambda () target-name))
|
||||
(define $* (lambda () target-basename))
|
||||
(define $< (lambda () primary-prerequisite))
|
||||
@ -459,17 +476,16 @@ installs it as the system driver. Returns the old system driver."
|
||||
(define $^ (lambda () (string-append-with-spaces prerequisites)))
|
||||
|
||||
(define (target-rule-prep-automatic-variables node rule)
|
||||
"FIXME-DOCS"
|
||||
(set! target-name (node-get-name node))
|
||||
(set! target-basename (basename target-name))
|
||||
(set! prerequisites (target-rule-get-prerequisites rule))
|
||||
(set! primary-prerequisite (if (null? prerequisites) "" (car prerequisites)))
|
||||
(set! newer-prerequisites
|
||||
;; If this node doesn't have a real file attached, then all
|
||||
;; prerequistes are "newer".
|
||||
;; If this node doesn't have a real file attached, then all prerequistes are "newer"
|
||||
(if (not (node-get-mtime node))
|
||||
prerequisites
|
||||
;; Prerequisites that have no mtime or a higher mtime are
|
||||
;; "newer".
|
||||
;; Prerequisites that have no mtime or a higher mtime are "newer"
|
||||
(filter-map
|
||||
(lambda (name)
|
||||
(cond
|
||||
@ -484,17 +500,16 @@ installs it as the system driver. Returns the old system driver."
|
||||
prerequisites))))
|
||||
|
||||
(define (suffix-rule-prep-automatic-variables node rule)
|
||||
"FIXME-DOCS"
|
||||
(set! target-name (node-get-name node))
|
||||
(set! target-basename (basename target-name))
|
||||
(set! primary-prerequisite (string-append target-basename (suffix-rule-get-source rule)))
|
||||
(set! prerequisites (list primary-prerequisite))
|
||||
(set! newer-prerequisites
|
||||
;; If this node doesn't have a real file attached, then the
|
||||
;; prerequisite is newer.
|
||||
;; If this node doesn't have a real file attached, then the prerequisite is newer
|
||||
(if (not (node-get-mtime node))
|
||||
(list primary-prerequisite)
|
||||
;; Prerequisites that have no mtime or a higher mtime are
|
||||
;; "newer".
|
||||
;; Prerequisites that have no mtime or a higher mtime are "newer"
|
||||
(cond
|
||||
((and (file-exists? primary-prerequisite)
|
||||
(regular-file? primary-prerequisite)
|
||||
@ -503,12 +518,12 @@ installs it as the system driver. Returns the old system driver."
|
||||
(else
|
||||
'())))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; MIXED METHODS
|
||||
;; requiring more than one of node, automatic variables, suffix rules
|
||||
;; and target rules
|
||||
;;; MIXED METHODS
|
||||
;;; requiring more than one of node, automatic variables, suffix rules and target rules
|
||||
|
||||
(define (add-builtins)
|
||||
"FIXME-DOCS"
|
||||
;; FIXME(Krey): Commented out by the original author, figure out what we want to do with it
|
||||
#|
|
||||
(-> ".c" ""
|
||||
(~ ($ CC) ($ CFLAGS) ($ LDFLAGS) "-o" $@ $<))
|
||||
@ -539,7 +554,7 @@ installs it as the system driver. Returns the old system driver."
|
||||
(~ ($ GUILD) "compile" ($ GFLAGS) $<)))
|
||||
|
||||
(define (run-target-rule! node)
|
||||
"Runs the (singular) target rule associated with this node."
|
||||
"Runs the (singular) target rule associated with this node"
|
||||
(unless (node? node)
|
||||
(scm-error 'wrong-type-arg "run-target-rule!" "Not a node: ~S" (list node) #f))
|
||||
|
||||
@ -561,8 +576,7 @@ installs it as the system driver. Returns the old system driver."
|
||||
status))))
|
||||
|
||||
(define (run-suffix-rules! node)
|
||||
"Runs the one-or-more suffix rules associated with this node. It
|
||||
runs them one-by-one, quitting on the first success."
|
||||
"Runs the one-or-more suffix rules associated with this node. It runs them one-by-one, quitting on the first success"
|
||||
(unless (node? node)
|
||||
(scm-error 'wrong-type'arg "run-suffix-rules!" "Not a node: ~S" (list node) #f))
|
||||
|
||||
@ -607,11 +621,12 @@ runs them one-by-one, quitting on the first success."
|
||||
(node-get-status node)))
|
||||
|
||||
(define (run-recipes! node recipes)
|
||||
"Runs the recipes on this node, one by one. Recipes are either
|
||||
strings, procedures that return strings, or generic procedures. If a
|
||||
"Runs the recipes on this node, one by one. Recipes are either strings, procedures that return strings, or generic procedures. If a
|
||||
failure condition happens, mark the node as having failed."
|
||||
(unless (node? node)
|
||||
(scm-error 'wrong-type-arg "run-recipes!" "Not a node: ~S" (list node) #f))
|
||||
|
||||
;; FIXME(Krey): Commented out by the original author, figure out what we want to do with it
|
||||
;;(unless (and (list? recipes) (not (null? recipes)))
|
||||
;; (scm-error 'wrong-type-arg "run-recipes!" "Not a non-null list: ~S" (list recipes) #f))
|
||||
|
||||
@ -623,10 +638,9 @@ failure condition happens, mark the node as having failed."
|
||||
(recipe (cdr opt/recipe)))
|
||||
;; Recipes are either
|
||||
;; - strings to pass to system
|
||||
;; - procedures that return a string which is passed
|
||||
;; to system
|
||||
;; - procedures (that don't return a string) that are executed
|
||||
;; that pass unless they return #f
|
||||
;; - procedures that return a string which is passed to system
|
||||
;; - procedures (that don't return a string) that are executed that pass unless they return #f
|
||||
|
||||
;; OPT is one of 'default, 'ignore, 'silent
|
||||
|
||||
(cond
|
||||
@ -650,8 +664,7 @@ failure condition happens, mark the node as having failed."
|
||||
((procedure? recipe)
|
||||
(let ((retval (recipe)))
|
||||
(cond
|
||||
;; If a procedure returns a string, that string gets
|
||||
;; processed by system.
|
||||
;; If a procedure returns a string, that string gets processed by system
|
||||
((string? retval)
|
||||
(when (= %verbosity 1)
|
||||
(format #t "~a~%~!" (node-get-name node)))
|
||||
@ -668,8 +681,7 @@ failure condition happens, mark the node as having failed."
|
||||
(set-fail! node))
|
||||
|
||||
(else
|
||||
;; Otherwise, this was a procedure that didn't return
|
||||
;; #f or a string, so it gets a pass.
|
||||
;; Otherwise, this was a procedure that didn't return #f or a string, so it gets a pass.
|
||||
(set-pass! node)))))
|
||||
|
||||
(else
|
||||
@ -686,8 +698,7 @@ failure condition happens, mark the node as having failed."
|
||||
(node-set-mtime! node (compute-mtime name)))))))
|
||||
|
||||
(define (run-default-rule! node)
|
||||
"The default rule if not other rule exists. It just passes if the
|
||||
file exists."
|
||||
"The default rule if not other rule exists. It just passes if the file exists"
|
||||
(let ((name (node-get-name node)))
|
||||
(if (and (file-exists? name)
|
||||
(regular-file? name))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user