Sync
Signed-off-by: Jacob Hrbek <kreyren@rixotstudio.cz>
This commit is contained in:
parent
ddb3640fb8
commit
6a8b09699e
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:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
;;; DOCS
|
;;; Backend code used for the parsing of non-guile makefiles
|
||||||
;;;
|
;;;
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(define (read-line-handle-escaped-newline)
|
(define (read-line-handle-escaped-newline)
|
||||||
"Reads a line of text from the current input port.
|
"Reads a line of text from the current input port.
|
||||||
|
|
||||||
If the line ends with an odd number of backslashes, the following line
|
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.
|
||||||
is read and appended. The output string has newlines as line
|
|
||||||
terminators.
|
|
||||||
|
|
||||||
It returns two values
|
It returns two values
|
||||||
- the string containing the one or more lines read
|
- 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)))))))
|
(values (string-append output line "\n") (1+ nline)))))))
|
||||||
|
|
||||||
(define* (string-collapse-continuations str #:optional (squash-whitespace? #f))
|
(define* (string-collapse-continuations str #:optional (squash-whitespace? #f))
|
||||||
"Returns a new string where backslash+newline is discarded, and
|
"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."
|
||||||
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)
|
(let loop ((str str)
|
||||||
(newline-index (string-rindex str #\newline)))
|
(newline-index (string-rindex str #\newline)))
|
||||||
(if (not newline-index)
|
(if (not newline-index)
|
||||||
|
@ -27,15 +27,18 @@
|
|||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
;;; DOCS
|
;;; Functionality to parse non-guile makefiles
|
||||||
;;;
|
;;;
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
;; A makefile can contain rules, macro definitions, include lines, and comments.
|
;; A makefile can contain rules, macro definitions, include lines, and comments.
|
||||||
|
|
||||||
|
;; FIXME-DOCS(Krey)
|
||||||
(define (parse filename)
|
(define (parse filename)
|
||||||
(with-input-from-file filename _eval #:guess-encoding #t))
|
(with-input-from-file filename _eval #:guess-encoding #t))
|
||||||
|
|
||||||
|
;; DNM-SECURITY(Krey): Check very carefully
|
||||||
|
;; FIXME-DOCS(Krey)
|
||||||
(define (_eval)
|
(define (_eval)
|
||||||
(let ((filenames #f)
|
(let ((filenames #f)
|
||||||
(ignoring #f)
|
(ignoring #f)
|
||||||
@ -62,7 +65,7 @@
|
|||||||
(newline)))))))
|
(newline)))))))
|
||||||
|
|
||||||
(define (string-parse-variable-definition str i)
|
(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)))
|
(let loop ((i (string-next-token str)))
|
||||||
(cond
|
(cond
|
||||||
((= i (string-length str))
|
((= i (string-length str))
|
||||||
@ -117,6 +120,8 @@
|
|||||||
(values i 'null)))))))
|
(values i 'null)))))))
|
||||||
(else
|
(else
|
||||||
(values i 'null)))))
|
(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)
|
(define (parse-var-assignment line)
|
||||||
(let ((i (string-next-token line 0)))
|
(let ((i (string-next-token line 0)))
|
||||||
@ -124,5 +129,6 @@
|
|||||||
#f
|
#f
|
||||||
;; else
|
;; else
|
||||||
(while #t
|
(while #t
|
||||||
|
|
||||||
|#
|
|#
|
||||||
|
|
||||||
|
;;; parse.scm ends here
|
||||||
|
@ -25,16 +25,25 @@
|
|||||||
#:use-module (potato text)
|
#:use-module (potato text)
|
||||||
#:export (parse))
|
#:export (parse))
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
;;;
|
||||||
|
;;; Core functionality of the parsed for non-guile makefiles
|
||||||
|
;;;
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
;; A makefile can contain rules, macro definitions, include lines,
|
;; A makefile can contain rules, macro definitions, include lines,
|
||||||
;; and comments.
|
;; and comments.
|
||||||
|
|
||||||
(define (parse filename)
|
(define (parse filename)
|
||||||
|
"FIXME-DOCS"
|
||||||
(with-input-from-file filename parse-input #:guess-encoding #t))
|
(with-input-from-file filename parse-input #:guess-encoding #t))
|
||||||
|
|
||||||
(define (last-char str)
|
(define (last-char str)
|
||||||
|
"FIXME-DOCS"
|
||||||
(string-ref str (1- (string-length str))))
|
(string-ref str (1- (string-length str))))
|
||||||
|
|
||||||
(define (parse-input)
|
(define (parse-input)
|
||||||
|
"FIXME-DOCS"
|
||||||
(while #t
|
(while #t
|
||||||
(let loop ((line "")
|
(let loop ((line "")
|
||||||
(str (read-line)))
|
(str (read-line)))
|
||||||
@ -68,8 +77,8 @@
|
|||||||
(define-peg-pattern COMMENT none (or C_COMMENT
|
(define-peg-pattern COMMENT none (or C_COMMENT
|
||||||
(and (+ C_SPACE) (not-followed-by peg-any))))
|
(and (+ C_SPACE) (not-followed-by peg-any))))
|
||||||
|
|
||||||
|
|
||||||
(define (parse-line line)
|
(define (parse-line line)
|
||||||
|
"FIXME-DOCS"
|
||||||
(write (peg:tree (match-pattern INCLUDE line)))
|
(write (peg:tree (match-pattern INCLUDE line)))
|
||||||
(newline)
|
(newline)
|
||||||
(write (peg:tree (match-pattern COMMENT line)))
|
(write (peg:tree (match-pattern COMMENT line)))
|
||||||
@ -90,17 +99,18 @@
|
|||||||
(else
|
(else
|
||||||
(format #t "UNKNOWN: ~S~%" line))))
|
(format #t "UNKNOWN: ~S~%" line))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(define (line-is-include? line)
|
(define (line-is-include? line)
|
||||||
|
"FIXME-DOCS"
|
||||||
(and (> (string-length line) 8)
|
(and (> (string-length line) 8)
|
||||||
(string= line "include " 0 8)))
|
(string= line "include " 0 8)))
|
||||||
|
|
||||||
(define (line-is-comment? line)
|
(define (line-is-comment? line)
|
||||||
|
"FIXME-DOCS"
|
||||||
(or (string-null? (string-trim-both line char-set:whitespace))
|
(or (string-null? (string-trim-both line char-set:whitespace))
|
||||||
(char=? (string-ref line 0) #\#)))
|
(char=? (string-ref line 0) #\#)))
|
||||||
|
|
||||||
(define (line-is-macro? line)
|
(define (line-is-macro? line)
|
||||||
|
"FIXME-DOCS"
|
||||||
(let ((len (string-length line)))
|
(let ((len (string-length line)))
|
||||||
(let loop ((i 0))
|
(let loop ((i 0))
|
||||||
(if (>= i len)
|
(if (>= i len)
|
||||||
@ -120,6 +130,7 @@
|
|||||||
(loop (+ i 1)))))))))
|
(loop (+ i 1)))))))))
|
||||||
|
|
||||||
(define (line-is-special-target? line)
|
(define (line-is-special-target? line)
|
||||||
|
"FIXME-DOCS"
|
||||||
(or (and (>= (string-length line) 8)
|
(or (and (>= (string-length line) 8)
|
||||||
(string= line ".DEFAULT" 0 8))
|
(string= line ".DEFAULT" 0 8))
|
||||||
(and (>= (string-length line) 8)
|
(and (>= (string-length line) 8)
|
||||||
@ -134,6 +145,7 @@
|
|||||||
(string= line ".SILENT" 0 7))))
|
(string= line ".SILENT" 0 7))))
|
||||||
|
|
||||||
(define (line-is-rule? line)
|
(define (line-is-rule? line)
|
||||||
|
"FIXME-DOCS"
|
||||||
(let ((len (string-length line)))
|
(let ((len (string-length line)))
|
||||||
(let loop ((i 0))
|
(let loop ((i 0))
|
||||||
(if (>= i len)
|
(if (>= i len)
|
||||||
@ -153,6 +165,7 @@
|
|||||||
(loop (+ i 1)))))))))
|
(loop (+ i 1)))))))))
|
||||||
|
|
||||||
(define (line-is-inference-rule? line)
|
(define (line-is-inference-rule? line)
|
||||||
|
"FIXME-DOCS"
|
||||||
(let ((len (string-length line)))
|
(let ((len (string-length line)))
|
||||||
(let loop ((i 0)
|
(let loop ((i 0)
|
||||||
(dot-count 0))
|
(dot-count 0))
|
||||||
@ -180,6 +193,7 @@
|
|||||||
0))))))))))
|
0))))))))))
|
||||||
|
|
||||||
(define (char-is-pcs? c)
|
(define (char-is-pcs? c)
|
||||||
|
"FIXME-DOCS"
|
||||||
(or (and (char<=? #\a c) (char>=? #\z c))
|
(or (and (char<=? #\a c) (char>=? #\z c))
|
||||||
(and (char<=? #\A c) (char>=? #\Z c))
|
(and (char<=? #\A c) (char>=? #\Z c))
|
||||||
(and (char<=? #\0 c) (char>=? #\9 c))
|
(and (char<=? #\0 c) (char>=? #\9 c))
|
||||||
@ -187,6 +201,8 @@
|
|||||||
(char=? #\_ c)))
|
(char=? #\_ c)))
|
||||||
|
|
||||||
(define (char-is-pcs-or-space? c)
|
(define (char-is-pcs-or-space? c)
|
||||||
|
"FIXME-DOCS"
|
||||||
(or (char-is-pcs? c)
|
(or (char-is-pcs? c)
|
||||||
(char=? #\space c)))
|
(char=? #\space c)))
|
||||||
|
|
||||||
|
;;; parser.scm ends here
|
||||||
|
@ -42,24 +42,26 @@
|
|||||||
string-compose ~
|
string-compose ~
|
||||||
silent-compose ~@
|
silent-compose ~@
|
||||||
always-execute-compose ~+
|
always-execute-compose ~+
|
||||||
ignore-error-compose ~-
|
ignore-error-compose ~-))
|
||||||
))
|
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
;;;
|
||||||
|
;;; Dedicated to logic processing of rules/tasks
|
||||||
|
;;;
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;; 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
|
||||||
;; GLOBALS
|
;; 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
|
||||||
|
|
||||||
(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
|
|
||||||
|
|
||||||
|
;;; 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)
|
(define (basename str)
|
||||||
"Strip off the '.ext' part of a filename string."
|
"Strip off the '.ext' part of a filename string."
|
||||||
(unless (string? str)
|
(unless (string? str)
|
||||||
@ -71,12 +73,9 @@
|
|||||||
str)))
|
str)))
|
||||||
|
|
||||||
(define (base-compose . args)
|
(define (base-compose . args)
|
||||||
"Returns a lambda that appends args together as a string,
|
"Returns a lambda that appends args together as a string, adding intermediate spaces. If an arg is a procedure, it is evaluated."
|
||||||
adding intermediate spaces. If an arg is a procedure,
|
|
||||||
it is evaluated."
|
|
||||||
(lambda ()
|
(lambda ()
|
||||||
;; Loop over all the args, appending them together as a
|
;; Loop over all the args, appending them together as a string. Try to be smart about the types of args.
|
||||||
;; string. Try to be smart about the types of args.
|
|
||||||
(let loop ((args args)
|
(let loop ((args args)
|
||||||
(result ""))
|
(result ""))
|
||||||
(cond
|
(cond
|
||||||
@ -95,8 +94,7 @@ it is evaluated."
|
|||||||
((string? arg)
|
((string? arg)
|
||||||
(set! effective-arg arg))
|
(set! effective-arg arg))
|
||||||
(else
|
(else
|
||||||
;; Not a string or procedure?
|
;; NOTE(spk121): Not a string or procedure? Let's just write it, I guess. YOLO!
|
||||||
;; Let's just write it, I guess. YOLO!
|
|
||||||
(set! effective-arg
|
(set! effective-arg
|
||||||
(format #f "~a" arg))))
|
(format #f "~a" arg))))
|
||||||
|
|
||||||
@ -112,26 +110,31 @@ it is evaluated."
|
|||||||
effective-arg)))))))))
|
effective-arg)))))))))
|
||||||
|
|
||||||
(define (string-compose . args)
|
(define (string-compose . args)
|
||||||
|
"FIXME-DOCS"
|
||||||
(cons 'default (apply base-compose args)))
|
(cons 'default (apply base-compose args)))
|
||||||
|
|
||||||
(define ~ string-compose)
|
(define ~ string-compose)
|
||||||
|
|
||||||
(define (ignore-error-compose . args)
|
(define (ignore-error-compose . args)
|
||||||
|
"FIXME-DOCS"
|
||||||
(cons 'ignore-error (apply base-compose args)))
|
(cons 'ignore-error (apply base-compose args)))
|
||||||
|
|
||||||
(define ~- ignore-error-compose)
|
(define ~- ignore-error-compose)
|
||||||
|
|
||||||
(define (silent-compose . args)
|
(define (silent-compose . args)
|
||||||
|
"FIXME-DOCS"
|
||||||
(cons 'silent (apply base-compose args)))
|
(cons 'silent (apply base-compose args)))
|
||||||
|
|
||||||
(define ~@ silent-compose)
|
(define ~@ silent-compose)
|
||||||
|
|
||||||
(define (always-execute-compose . args)
|
(define (always-execute-compose . args)
|
||||||
|
"FIXME-DOCS"
|
||||||
(cons 'always-execute (apply base-compose args)))
|
(cons 'always-execute (apply base-compose args)))
|
||||||
|
|
||||||
(define ~+ always-execute-compose)
|
(define ~+ always-execute-compose)
|
||||||
|
|
||||||
(define (regular-file? filename)
|
(define (regular-file? filename)
|
||||||
|
"FIXME-DOCS"
|
||||||
(unless (string? filename)
|
(unless (string? filename)
|
||||||
(scm-error 'wrong-type-arg "regular-file?" "Not a string: ~S" (list filename) #f))
|
(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)))
|
(eq? (stat:type st) 'regular)))
|
||||||
|
|
||||||
(define (compute-mtime filename)
|
(define (compute-mtime filename)
|
||||||
|
"FIXME-DOCS"
|
||||||
(unless (string? filename)
|
(unless (string? filename)
|
||||||
(scm-error 'wrong-type-arg "regular-file?" "Not a string: ~S" (list filename) #f))
|
(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))
|
(+ (* 1000000000 (stat:mtime st))
|
||||||
(stat:mtimensec st))))
|
(stat:mtimensec st))))
|
||||||
|
|
||||||
|
;; FIXME-DOCS/QA(Krey): What is this doing?
|
||||||
(define %system-proc system)
|
(define %system-proc system)
|
||||||
|
|
||||||
(define (install-alternate-system-driver proc)
|
(define (install-alternate-system-driver proc)
|
||||||
"Give a procure to use rather than the standard 'system' procedure,
|
"Give a procure to use rather than the standard 'system' procedure, installs it as the system driver. Returns the old system driver."
|
||||||
installs it as the system driver. Returns the old system driver."
|
|
||||||
(unless (procedure? proc)
|
(unless (procedure? proc)
|
||||||
(scm-error 'wrong-type-arg "install-alternate-system-driver" "Not a procedure: ~S" (list proc) #f))
|
(scm-error 'wrong-type-arg "install-alternate-system-driver" "Not a procedure: ~S" (list proc) #f))
|
||||||
(let ((old-proc %system-proc))
|
(let ((old-proc %system-proc))
|
||||||
(set! %system-proc proc)
|
(set! %system-proc proc)
|
||||||
old-proc))
|
old-proc))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;; TARGET STRUCT AND METHODS
|
||||||
;; TARGET STRUCT AND METHODS
|
|
||||||
|
|
||||||
(define-record-type <target-rule>
|
(define-record-type <target-rule>
|
||||||
(make-target-rule name prerequisites recipes priority)
|
(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)
|
(when (null? recipes)
|
||||||
(set! recipes (list #t)))
|
(set! recipes (list #t)))
|
||||||
|
|
||||||
;; If any recipes are raw strings, we need to make them into
|
;; NOTE(spk121): If any recipes are raw strings, we need to make them into `(cons 'default string)`
|
||||||
;; (cons 'default string)
|
|
||||||
(let ((recipes2
|
(let ((recipes2
|
||||||
(map (lambda (recipe)
|
(map (lambda (recipe)
|
||||||
(cond
|
(cond
|
||||||
@ -214,8 +216,7 @@ installs it as the system driver. Returns the old system driver."
|
|||||||
;; else
|
;; else
|
||||||
(target-rule-get-name (last %target-rules))))
|
(target-rule-get-name (last %target-rules))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;; SUFFIX STRUCT AND METHODS
|
||||||
;; SUFFIX STRUCT AND METHODS
|
|
||||||
|
|
||||||
(define-record-type <suffix-rule>
|
(define-record-type <suffix-rule>
|
||||||
(make-suffix-rule source-suffix target-suffix recipes priority)
|
(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)
|
(define (suffix-rule source target . recipes)
|
||||||
"Register a suffix rule"
|
"Register a suffix rule"
|
||||||
|
|
||||||
;; FIXME: Typecheck
|
;; FIXME(spk121): Typecheck
|
||||||
(when (>= %verbosity 3)
|
(when (>= %verbosity 3)
|
||||||
(format #t "Suffix rule: ~a~A~a ~A ~a~A~a~%~!"
|
(format #t "Suffix rule: ~a~A~a ~A ~a~A~a~%~!"
|
||||||
(lquo) source (rquo) (right-arrow) (lquo) target (rquo)))
|
(lquo) source (rquo) (right-arrow) (lquo) target (rquo)))
|
||||||
|
|
||||||
;; If any recipes are raw strings, we need to make them into
|
;; NOTE(spk121): If any recipes are raw strings, we need to make them into `(cons 'default string)`
|
||||||
;; (cons 'default string)
|
|
||||||
(let ((recipes2
|
(let ((recipes2
|
||||||
(map (lambda (recipe)
|
(map (lambda (recipe)
|
||||||
(cond
|
(cond
|
||||||
@ -261,8 +261,7 @@ installs it as the system driver. Returns the old system driver."
|
|||||||
;; Alias
|
;; Alias
|
||||||
(define -> suffix-rule)
|
(define -> suffix-rule)
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;; NODE STRUCT AND METHODS
|
||||||
;; NODE STRUCT AND METHODS
|
|
||||||
|
|
||||||
(define-record-type <node>
|
(define-record-type <node>
|
||||||
(make-node name parent status)
|
(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!)
|
(rule-type node-get-rule-type node-set-rule-type!)
|
||||||
;; A list of rules
|
;; A list of rules
|
||||||
(rules node-get-rules node-set-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)
|
(define (using-target-rule? node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(eq? 'target (node-get-rule-type node)))
|
(eq? 'target (node-get-rule-type node)))
|
||||||
(define (using-suffix-rules? node)
|
(define (using-suffix-rules? node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(eq? 'suffix (node-get-rule-type node)))
|
(eq? 'suffix (node-get-rule-type node)))
|
||||||
(define (using-default-rule? node)
|
(define (using-default-rule? node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(eq? 'default (node-get-rule-type node)))
|
(eq? 'default (node-get-rule-type node)))
|
||||||
|
|
||||||
(define (set-fail! node)
|
(define (set-fail! node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(node-set-status! node 'fail))
|
(node-set-status! node 'fail))
|
||||||
|
|
||||||
(define (set-pass! node)
|
(define (set-pass! node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(node-set-status! node 'pass))
|
(node-set-status! node 'pass))
|
||||||
|
|
||||||
(define (failed? node)
|
(define (failed? node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(eqv? (node-get-status node) 'fail))
|
(eqv? (node-get-status node) 'fail))
|
||||||
|
|
||||||
(define (passed? node)
|
(define (passed? node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(eqv? (node-get-status node) 'pass))
|
(eqv? (node-get-status node) 'pass))
|
||||||
|
|
||||||
(define (leaf-node? node)
|
(define (leaf-node? node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(null? (node-get-children node)))
|
(null? (node-get-children node)))
|
||||||
|
|
||||||
(define (undetermined? node)
|
(define (undetermined? node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(eq? (node-get-status node) 'undetermined))
|
(eq? (node-get-status node) 'undetermined))
|
||||||
|
|
||||||
(define (any-child-has-passed? node)
|
(define (any-child-has-passed? node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(unless (node? node)
|
(unless (node? node)
|
||||||
(scm-error 'wrong-type-arg "any-child-has-passed?" "Not a node: ~S" (list node) #f))
|
(scm-error 'wrong-type-arg "any-child-has-passed?" "Not a node: ~S" (list node) #f))
|
||||||
(when (null? (node-get-children node))
|
(when (null? (node-get-children node))
|
||||||
@ -321,6 +329,7 @@ installs it as the system driver. Returns the old system driver."
|
|||||||
(any passed? children)))
|
(any passed? children)))
|
||||||
|
|
||||||
(define (every-child-has-passed? node)
|
(define (every-child-has-passed? node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(unless (node? node)
|
(unless (node? node)
|
||||||
(scm-error 'wrong-type-arg "every-child-has-passed?" "Not a node: ~S" (list node) #f))
|
(scm-error 'wrong-type-arg "every-child-has-passed?" "Not a node: ~S" (list node) #f))
|
||||||
(when (null? (node-get-children node))
|
(when (null? (node-get-children node))
|
||||||
@ -331,6 +340,7 @@ installs it as the system driver. Returns the old system driver."
|
|||||||
(every passed? children)))
|
(every passed? children)))
|
||||||
|
|
||||||
(define (any-child-has-failed? node)
|
(define (any-child-has-failed? node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(unless (node? node)
|
(unless (node? node)
|
||||||
(scm-error 'wrong-type-arg "any-child-has-failed?" "Not a node: ~S" (list node) #f))
|
(scm-error 'wrong-type-arg "any-child-has-failed?" "Not a node: ~S" (list node) #f))
|
||||||
(when (null? (node-get-children node))
|
(when (null? (node-get-children node))
|
||||||
@ -341,6 +351,7 @@ installs it as the system driver. Returns the old system driver."
|
|||||||
(any failed? children)))
|
(any failed? children)))
|
||||||
|
|
||||||
(define (every-child-has-failed? node)
|
(define (every-child-has-failed? node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(unless (node? node)
|
(unless (node? node)
|
||||||
(scm-error 'wrong-type-arg "every-child-has-failed?" "Not a node: ~S" (list node) #f))
|
(scm-error 'wrong-type-arg "every-child-has-failed?" "Not a node: ~S" (list node) #f))
|
||||||
(when (null? (node-get-children node))
|
(when (null? (node-get-children node))
|
||||||
@ -351,6 +362,7 @@ installs it as the system driver. Returns the old system driver."
|
|||||||
(every failed? children)))
|
(every failed? children)))
|
||||||
|
|
||||||
(define (children-complete? node)
|
(define (children-complete? node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(cond
|
(cond
|
||||||
((leaf-node? node)
|
((leaf-node? node)
|
||||||
#t)
|
#t)
|
||||||
@ -364,6 +376,7 @@ installs it as the system driver. Returns the old system driver."
|
|||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
(define (children-passed? node)
|
(define (children-passed? node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(cond
|
(cond
|
||||||
((null? (node-get-children node))
|
((null? (node-get-children node))
|
||||||
#t)
|
#t)
|
||||||
@ -388,16 +401,19 @@ installs it as the system driver. Returns the old system driver."
|
|||||||
children)))))
|
children)))))
|
||||||
|
|
||||||
(define (has-parent? node)
|
(define (has-parent? node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(if (node-get-parent node)
|
(if (node-get-parent node)
|
||||||
#t
|
#t
|
||||||
#f))
|
#f))
|
||||||
|
|
||||||
(define (has-children? node)
|
(define (has-children? node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(if (null? (node-get-children node))
|
(if (null? (node-get-children node))
|
||||||
#f
|
#f
|
||||||
#t))
|
#t))
|
||||||
|
|
||||||
(define (get-parent node)
|
(define (get-parent node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(node-get-parent node))
|
(node-get-parent node))
|
||||||
|
|
||||||
(define (up-to-date? node)
|
(define (up-to-date? node)
|
||||||
@ -420,6 +436,7 @@ installs it as the system driver. Returns the old system driver."
|
|||||||
#f)))))
|
#f)))))
|
||||||
|
|
||||||
(define (node-depth node)
|
(define (node-depth node)
|
||||||
|
"FIXME-DOCS"
|
||||||
(let loop ((depth 0)
|
(let loop ((depth 0)
|
||||||
(cur node))
|
(cur node))
|
||||||
(if (has-parent? cur)
|
(if (has-parent? cur)
|
||||||
@ -430,14 +447,13 @@ installs it as the system driver. Returns the old system driver."
|
|||||||
(define (node-depth-string node)
|
(define (node-depth-string node)
|
||||||
(make-string (* 2 (node-depth node)) #\space))
|
(make-string (* 2 (node-depth node)) #\space))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;; AUTOMATIC VARIABLES
|
;; AUTOMATIC VARIABLES
|
||||||
|
|
||||||
(define target-name 'unspecified)
|
(define target-name 'unspecified) ;; FIXME-DOCS(Krey): What is this variable doing?
|
||||||
(define target-basename 'unspecified)
|
(define target-basename 'unspecified) ;; FIXME-DOCS(Krey): What is this variable doing?
|
||||||
(define prerequisites '())
|
(define prerequisites '()) ;; FIXME-DOCS(Krey): What is this variable doing?
|
||||||
(define primary-prerequisite 'unspecified)
|
(define primary-prerequisite 'unspecified) ;; FIXME-DOCS(Krey): What is this variable doing?
|
||||||
(define newer-prerequisites '())
|
(define newer-prerequisites '()) ;; FIXME-DOCS(Krey): What is this variable doing?
|
||||||
|
|
||||||
(define (string-append-with-spaces lst)
|
(define (string-append-with-spaces lst)
|
||||||
"Appends the strings in lst, adding spaces in between."
|
"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)
|
(car lst)
|
||||||
(cdr lst))))
|
(cdr lst))))
|
||||||
|
|
||||||
|
;; Aliases
|
||||||
(define $@ (lambda () target-name))
|
(define $@ (lambda () target-name))
|
||||||
(define $* (lambda () target-basename))
|
(define $* (lambda () target-basename))
|
||||||
(define $< (lambda () primary-prerequisite))
|
(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 $^ (lambda () (string-append-with-spaces prerequisites)))
|
||||||
|
|
||||||
(define (target-rule-prep-automatic-variables node rule)
|
(define (target-rule-prep-automatic-variables node rule)
|
||||||
|
"FIXME-DOCS"
|
||||||
(set! target-name (node-get-name node))
|
(set! target-name (node-get-name node))
|
||||||
(set! target-basename (basename target-name))
|
(set! target-basename (basename target-name))
|
||||||
(set! prerequisites (target-rule-get-prerequisites rule))
|
(set! prerequisites (target-rule-get-prerequisites rule))
|
||||||
(set! primary-prerequisite (if (null? prerequisites) "" (car prerequisites)))
|
(set! primary-prerequisite (if (null? prerequisites) "" (car prerequisites)))
|
||||||
(set! newer-prerequisites
|
(set! newer-prerequisites
|
||||||
;; If this node doesn't have a real file attached, then all
|
;; If this node doesn't have a real file attached, then all prerequistes are "newer"
|
||||||
;; prerequistes are "newer".
|
|
||||||
(if (not (node-get-mtime node))
|
(if (not (node-get-mtime node))
|
||||||
prerequisites
|
prerequisites
|
||||||
;; Prerequisites that have no mtime or a higher mtime are
|
;; Prerequisites that have no mtime or a higher mtime are "newer"
|
||||||
;; "newer".
|
|
||||||
(filter-map
|
(filter-map
|
||||||
(lambda (name)
|
(lambda (name)
|
||||||
(cond
|
(cond
|
||||||
@ -484,17 +500,16 @@ installs it as the system driver. Returns the old system driver."
|
|||||||
prerequisites))))
|
prerequisites))))
|
||||||
|
|
||||||
(define (suffix-rule-prep-automatic-variables node rule)
|
(define (suffix-rule-prep-automatic-variables node rule)
|
||||||
|
"FIXME-DOCS"
|
||||||
(set! target-name (node-get-name node))
|
(set! target-name (node-get-name node))
|
||||||
(set! target-basename (basename target-name))
|
(set! target-basename (basename target-name))
|
||||||
(set! primary-prerequisite (string-append target-basename (suffix-rule-get-source rule)))
|
(set! primary-prerequisite (string-append target-basename (suffix-rule-get-source rule)))
|
||||||
(set! prerequisites (list primary-prerequisite))
|
(set! prerequisites (list primary-prerequisite))
|
||||||
(set! newer-prerequisites
|
(set! newer-prerequisites
|
||||||
;; If this node doesn't have a real file attached, then the
|
;; If this node doesn't have a real file attached, then the prerequisite is newer
|
||||||
;; prerequisite is newer.
|
|
||||||
(if (not (node-get-mtime node))
|
(if (not (node-get-mtime node))
|
||||||
(list primary-prerequisite)
|
(list primary-prerequisite)
|
||||||
;; Prerequisites that have no mtime or a higher mtime are
|
;; Prerequisites that have no mtime or a higher mtime are "newer"
|
||||||
;; "newer".
|
|
||||||
(cond
|
(cond
|
||||||
((and (file-exists? primary-prerequisite)
|
((and (file-exists? primary-prerequisite)
|
||||||
(regular-file? primary-prerequisite)
|
(regular-file? primary-prerequisite)
|
||||||
@ -503,12 +518,12 @@ installs it as the system driver. Returns the old system driver."
|
|||||||
(else
|
(else
|
||||||
'())))))
|
'())))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;; MIXED METHODS
|
||||||
;; MIXED METHODS
|
;;; requiring more than one of node, automatic variables, suffix rules and target rules
|
||||||
;; requiring more than one of node, automatic variables, suffix rules
|
|
||||||
;; and target rules
|
|
||||||
|
|
||||||
(define (add-builtins)
|
(define (add-builtins)
|
||||||
|
"FIXME-DOCS"
|
||||||
|
;; FIXME(Krey): Commented out by the original author, figure out what we want to do with it
|
||||||
#|
|
#|
|
||||||
(-> ".c" ""
|
(-> ".c" ""
|
||||||
(~ ($ CC) ($ CFLAGS) ($ LDFLAGS) "-o" $@ $<))
|
(~ ($ CC) ($ CFLAGS) ($ LDFLAGS) "-o" $@ $<))
|
||||||
@ -539,7 +554,7 @@ installs it as the system driver. Returns the old system driver."
|
|||||||
(~ ($ GUILD) "compile" ($ GFLAGS) $<)))
|
(~ ($ GUILD) "compile" ($ GFLAGS) $<)))
|
||||||
|
|
||||||
(define (run-target-rule! node)
|
(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)
|
(unless (node? node)
|
||||||
(scm-error 'wrong-type-arg "run-target-rule!" "Not a node: ~S" (list node) #f))
|
(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))))
|
status))))
|
||||||
|
|
||||||
(define (run-suffix-rules! node)
|
(define (run-suffix-rules! node)
|
||||||
"Runs the one-or-more suffix rules associated with this node. It
|
"Runs the one-or-more suffix rules associated with this node. It runs them one-by-one, quitting on the first success"
|
||||||
runs them one-by-one, quitting on the first success."
|
|
||||||
(unless (node? node)
|
(unless (node? node)
|
||||||
(scm-error 'wrong-type'arg "run-suffix-rules!" "Not a node: ~S" (list node) #f))
|
(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)))
|
(node-get-status node)))
|
||||||
|
|
||||||
(define (run-recipes! node recipes)
|
(define (run-recipes! node recipes)
|
||||||
"Runs the recipes on this node, one by one. Recipes are either
|
"Runs the recipes on this node, one by one. Recipes are either strings, procedures that return strings, or generic procedures. If a
|
||||||
strings, procedures that return strings, or generic procedures. If a
|
|
||||||
failure condition happens, mark the node as having failed."
|
failure condition happens, mark the node as having failed."
|
||||||
(unless (node? node)
|
(unless (node? node)
|
||||||
(scm-error 'wrong-type-arg "run-recipes!" "Not a node: ~S" (list node) #f))
|
(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)))
|
;;(unless (and (list? recipes) (not (null? recipes)))
|
||||||
;; (scm-error 'wrong-type-arg "run-recipes!" "Not a non-null list: ~S" (list recipes) #f))
|
;; (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)))
|
(recipe (cdr opt/recipe)))
|
||||||
;; Recipes are either
|
;; Recipes are either
|
||||||
;; - strings to pass to system
|
;; - strings to pass to system
|
||||||
;; - procedures that return a string which is passed
|
;; - procedures that return a string which is passed to system
|
||||||
;; to system
|
;; - procedures (that don't return a string) that are executed that pass unless they return #f
|
||||||
;; - procedures (that don't return a string) that are executed
|
|
||||||
;; that pass unless they return #f
|
|
||||||
;; OPT is one of 'default, 'ignore, 'silent
|
;; OPT is one of 'default, 'ignore, 'silent
|
||||||
|
|
||||||
(cond
|
(cond
|
||||||
@ -650,8 +664,7 @@ failure condition happens, mark the node as having failed."
|
|||||||
((procedure? recipe)
|
((procedure? recipe)
|
||||||
(let ((retval (recipe)))
|
(let ((retval (recipe)))
|
||||||
(cond
|
(cond
|
||||||
;; If a procedure returns a string, that string gets
|
;; If a procedure returns a string, that string gets processed by system
|
||||||
;; processed by system.
|
|
||||||
((string? retval)
|
((string? retval)
|
||||||
(when (= %verbosity 1)
|
(when (= %verbosity 1)
|
||||||
(format #t "~a~%~!" (node-get-name node)))
|
(format #t "~a~%~!" (node-get-name node)))
|
||||||
@ -668,8 +681,7 @@ failure condition happens, mark the node as having failed."
|
|||||||
(set-fail! node))
|
(set-fail! node))
|
||||||
|
|
||||||
(else
|
(else
|
||||||
;; Otherwise, this was a procedure that didn't return
|
;; Otherwise, this was a procedure that didn't return #f or a string, so it gets a pass.
|
||||||
;; #f or a string, so it gets a pass.
|
|
||||||
(set-pass! node)))))
|
(set-pass! node)))))
|
||||||
|
|
||||||
(else
|
(else
|
||||||
@ -686,8 +698,7 @@ failure condition happens, mark the node as having failed."
|
|||||||
(node-set-mtime! node (compute-mtime name)))))))
|
(node-set-mtime! node (compute-mtime name)))))))
|
||||||
|
|
||||||
(define (run-default-rule! node)
|
(define (run-default-rule! node)
|
||||||
"The default rule if not other rule exists. It just passes if the
|
"The default rule if not other rule exists. It just passes if the file exists"
|
||||||
file exists."
|
|
||||||
(let ((name (node-get-name node)))
|
(let ((name (node-get-name node)))
|
||||||
(if (and (file-exists? name)
|
(if (and (file-exists? name)
|
||||||
(regular-file? name))
|
(regular-file? name))
|
||||||
|
Loading…
Reference in New Issue
Block a user