From ddef402c699f573e8d756356bf738d6a95ad10b0 Mon Sep 17 00:00:00 2001 From: Jacob Hrbek Date: Sat, 3 Sep 2022 10:10:11 +0200 Subject: [PATCH] Sync Signed-off-by: Jacob Hrbek --- TAGS.org | 9 ++ src/potato/rules.scm | 353 +++++++++++++++++++++++-------------------- src/potato/text.scm | 64 +++++--- 3 files changed, 239 insertions(+), 187 deletions(-) diff --git a/TAGS.org b/TAGS.org index 79cb19c..407b7da 100644 --- a/TAGS.org +++ b/TAGS.org @@ -18,6 +18,15 @@ Which in practice might be used as: - 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 + - FIXME-TRANSLATE = Needs definition for handling translations - 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 +- TRANSLATE = Needs to be translated + + +** Repository-wide tags + +Tags that apply repository-wide + +- FIXME(Krey): The repository is using things like =(format ... (green)..)= to make the text green, these should be renamed on e.g. =(font-green)= diff --git a/src/potato/rules.scm b/src/potato/rules.scm index d85409e..fdf2dfd 100644 --- a/src/potato/rules.scm +++ b/src/potato/rules.scm @@ -759,73 +759,70 @@ failure condition happens, mark the node as having failed." (define (create-node name parent) "Constructs a tree of nodes, with name as the root node." (when (and (node? parent) (> (node-depth parent) 30)) + ;; FIXME-TRANSLATE(Krey) (error "Stack overflow")) (let ((node (make-node name parent 'undetermined))) (node-set-children! node '()) (node-set-rule-type! node 'default) - ;; FIXME: here check that this name differs from all ancestor's - ;; names + ;; FIXME(spk121): here check that this name differs from all ancestor's names ;; Try to the file's modification time. (when (file-exists? name) (when (not (regular-file? name)) - (not-a-regular-file "create-node" name)) + (not-a-regular-file "create-node" name)) (when (not (access? name R_OK)) - (no-read-access-to-file "create-node" name)) + (no-read-access-to-file "create-node" name)) (node-set-mtime! node (compute-mtime name))) - ;; Search for matching target rule. + ;; Search for matching target rule (when (not (null? %target-rules)) (let loop ((rule (car %target-rules)) - (rest (cdr %target-rules))) + (rest (cdr %target-rules))) - ;; N.B: here we assume target rule names and - ;; predicates are exclusively strings. - (if (string=? name (target-rule-get-name rule)) - (begin - ;; OK we have a matching rule - (node-set-rules! node (list rule)) - (node-set-rule-type! node 'target) - ;; For target-rules, the prerequisites comes from the - ;; rule itself. + ;; NOTE(spk121): here we assume target rule names and predicates are exclusively strings + (if (string=? name (target-rule-get-name rule)) + (begin + ;; OK we have a matching rule + (node-set-rules! node (list rule)) + (node-set-rule-type! node 'target) + ;; For target-rules, the prerequisites comes from the rule itself - ;; Oooh, recursion! - (node-set-children! node - (map (lambda (prereq) - (create-node prereq node)) - (target-rule-get-prerequisites rule)))) - ;; else - (if (not (null? rest)) - (loop (car rest) (cdr rest)) - ;; else, no matching rule found - (node-set-rules! node '()))))) + ;; Oooh, recursion! + (node-set-children! node + (map (lambda (prereq) + (create-node prereq node)) + (target-rule-get-prerequisites rule)))) + ;; else + (if (not (null? rest)) + (loop (car rest) (cdr rest)) + ;; else, no matching rule found + (node-set-rules! node '()))))) ;; If no rule found so far, search for suffix rules. (when (null? (node-get-rules node)) (for-each (lambda (rule) - (let ((targ (suffix-rule-get-target rule))) - (when (string-suffix? targ name) - ;; For suffix rules, there will be exactly one child per - ;; rule and the name of the child is constructed from a - ;; suffix and the parent's name. - (node-set-rules! node (cons rule (node-get-rules node))) - (node-set-rule-type! node 'suffix) - (let* ((src (suffix-rule-get-source rule)) - (prereq - (string-append - (string-drop-right name (string-length src)) - src))) + (let ((targ (suffix-rule-get-target rule))) + (when (string-suffix? targ name) + ;; For suffix rules, there will be exactly one child per rule and the name of the child is constructed from a suffix and the parent's name + (node-set-rules! node (cons rule (node-get-rules node))) + (node-set-rule-type! node 'suffix) + (let* ((src (suffix-rule-get-source rule)) + (prereq + (string-append + (string-drop-right name (string-length src)) + src))) - ;; Note the recursion here. - (node-set-children! node - (cons (create-node prereq node) - (node-get-children node))))))) + ;; Note the recursion here. + (node-set-children! node + (cons (create-node prereq node) + (node-get-children node))))))) %suffix-rules)) - ;; FIXME: First matching rule has highest priority? Or is last better? + ;; FIXME(spk121): First matching rule has highest priority? Or is last better? (node-set-rules! node (reverse (node-get-rules node))) (node-set-children! node (reverse (node-get-children node))) + ;; FIXME(Krey): This was commented out by the original author, figure out what we want to do with it ;;(format #t "matching suffix rules ~S~%~!" (node-get-rules node)) ;;(format #t "matching children rules ~S~%~!" (node-get-children node)) @@ -838,133 +835,155 @@ This is where the magic happens." (let ((tree (create-node root #f))) (let ((node tree)) (when (>= %verbosity 3) - (format #t "~ABegin building target ~a~A~a.~%~!" - (node-depth-string node) (lquo) (node-get-name node) (rquo))) + ;; FIXME-TRANSLATE(Krey) + (format #t "~ABegin building target ~a~A~a.~%~!" + (node-depth-string node) (lquo) (node-get-name node) (rquo))) (while #t - (when (>= %verbosity 3) - (format #t "~AConsidering target ~a~A~a.~%~!" - (node-depth-string node) (lquo) (node-get-name node) (rquo))) - (if (undetermined? node) - (begin - (when (>= %verbosity 3) - (format #t "~ATarget file ~a~A~a is undetermined.~%~!" - (node-depth-string node) (lquo) (node-get-name node) (rquo)) - (unless (node-get-mtime node) - (format #t "~AFile ~a~A~a does not exist.~%~!" - (node-depth-string node) (lquo) (node-get-name node) (rquo)))) - (if (children-complete? node) - (begin - (when (and (>= %verbosity 3) (has-children? node)) - (format #t "~AFinished prerequisites of target file ~a~A~a.~%~!" - (node-depth-string node) (lquo) (node-get-name node) (rquo))) - (if (children-passed? node) - (begin - (when (and (>= %verbosity 3) (has-children? node)) - (format #t "~AThe prerequisites of target file ~a~A~a have passed.~%~!" - (node-depth-string node) (lquo) (node-get-name node) (rquo))) - (if (up-to-date? node) - (begin - (when (node-get-mtime node) - (when (>= %verbosity 3) - (format #t "~ATarget file ~a~A~a is up to date.~%~!" - (node-depth-string node) - (lquo) (node-get-name node) (rquo)))) - (set-pass! node)) - ;; else, not up to date - (begin - (when (>= %verbosity 3) - (format #t "~ATarget file ~a~A~a is not up to date.~%~!" - (node-depth-string node) - (lquo) (node-get-name node) (rquo))) - (cond - ((using-target-rule? node) - (when (>= %verbosity 3) - (format #t "~ATarget file ~a~A~a has a target rule.~%~!" - (node-depth-string node) - (lquo) (node-get-name node) (rquo))) - (run-target-rule! node)) - ((using-suffix-rules? node) - (when (>= %verbosity 3) - (format #t "~ATarget file ~a~A~a has a suffix rule.~%~!" - (node-depth-string node) - (lquo) (node-get-name node) (rquo))) - (run-suffix-rules! node)) - ((using-default-rule? node) - (when (>= %verbosity 3) - (format #t "~ATarget file ~a~A~a is using the default rule.~%~!" - (node-depth-string node) - (lquo) (node-get-name node) (rquo))) - (run-default-rule! node)) - (else - (error "bad rules"))) + (when (>= %verbosity 3) + ;; FIXME-TRANSLATE(Krey) + (format #t "~AConsidering target ~a~A~a.~%~!" + (node-depth-string node) (lquo) (node-get-name node) (rquo))) + (if (undetermined? node) + (begin + (when (>= %verbosity 3) + ;; FIXME-TRANSLATE(Krey) + (format #t "~ATarget file ~a~A~a is undetermined.~%~!" + (node-depth-string node) (lquo) (node-get-name node) (rquo)) + (unless (node-get-mtime node) + ;; FIXME-TRANSLATE(Krey) + (format #t "~AFile ~a~A~a does not exist.~%~!" + (node-depth-string node) (lquo) (node-get-name node) (rquo)))) + (if (children-complete? node) + (begin + (when (and (>= %verbosity 3) (has-children? node)) + ;; FIXME-TRANSLATE(Krey) + (format #t "~AFinished prerequisites of target file ~a~A~a.~%~!" + (node-depth-string node) (lquo) (node-get-name node) (rquo))) + (if (children-passed? node) + (begin + (when (and (>= %verbosity 3) (has-children? node)) + ;; FIXME-TRANSLATE(Krey) + (format #t "~AThe prerequisites of target file ~a~A~a have passed.~%~!" + (node-depth-string node) (lquo) (node-get-name node) (rquo))) + (if (up-to-date? node) + (begin + (when (node-get-mtime node) + (when (>= %verbosity 3) + ;; FIXME-TRANSLATE(Krey) + (format #t "~ATarget file ~a~A~a is up to date.~%~!" + (node-depth-string node) + (lquo) (node-get-name node) (rquo)))) + (set-pass! node)) + ;; else, not up to date + (begin + (when (>= %verbosity 3) + ;; FIXME-TRANSLATE(Krey) + (format #t "~ATarget file ~a~A~a is not up to date.~%~!" + (node-depth-string node) + (lquo) (node-get-name node) (rquo))) + (cond + ((using-target-rule? node) + (when (>= %verbosity 3) + ;; FIXME-TRANSLATE(Krey) + (format #t "~ATarget file ~a~A~a has a target rule.~%~!" + (node-depth-string node) + (lquo) (node-get-name node) (rquo))) + (run-target-rule! node)) + ((using-suffix-rules? node) + (when (>= %verbosity 3) + (format #t "~ATarget file ~a~A~a has a suffix rule.~%~!" + (node-depth-string node) + (lquo) (node-get-name node) (rquo))) + (run-suffix-rules! node)) + ((using-default-rule? node) + (when (>= %verbosity 3) + ;; FIXME-TRANSLATE(Krey) + (format #t "~ATarget file ~a~A~a is using the default rule.~%~!" + (node-depth-string node) + (lquo) (node-get-name node) (rquo))) + (run-default-rule! node)) + (else + (error "bad rules"))) - (if (passed? node) - (when (>= %verbosity 3) - (format #t "~ATarget file ~a~A~a has passed.~%~!" - (node-depth-string node) - (lquo) (node-get-name node) (rquo))) - (when (>= %verbosity 3) - (format #t "~ATarget file ~a~A~a has failed.~%~!" - (node-depth-string node) - (lquo) (node-get-name node) (rquo))))))) - ;; else, children have failed - (begin - (when (>= %verbosity 3) - (format #t "~AThe prerequisites of target file ~a~A~a have failed.~%~!" - (node-depth-string node) (lquo) (node-get-name node) (rquo))) - (set-fail! node)))) - ;; else, children aren't complete - (begin - (when (>= %verbosity 3) - (format #t "~AThe prerequisites of target file ~a~A~a are incomplete.~%~!" - (node-depth-string node) (lquo) (node-get-name node) (rquo))) - (let ((next (get-next-child node))) - (when (>= %verbosity 3) - (format #t "~ADescending node ~a~A~a ~a ~a~A~a.~%~!" - (node-depth-string node) - (lquo) (node-get-name node) (rquo) - (right-arrow) - (lquo) (node-get-name next) (rquo))) - (set! node (get-next-child node)) - )))) - ;; else, this node is determined - (begin - (if (passed? node) - (when (>= %verbosity 2) - (format #t "~A~a~A~a: ~APASS~A~%~!" - (node-depth-string node) (lquo) (node-get-name node) (rquo) - (green) (default))) - (when (>= %verbosity 2) - (format #t "~A~a~A~a: ~AFAIL~A~%~!" - (node-depth-string node) (lquo) (node-get-name node) (rquo) - (red) (default)))) - (if (has-parent? node) - (begin - (when (>= %verbosity 3) - (format #t "~AAscending node ~a~A~a ~a ~a~A~a.~%~!" - (node-depth-string node) - (lquo) (node-get-name node) (rquo) - (right-arrow) - (lquo) (node-get-name (node-get-parent node)) (rquo))) + (if (passed? node) + (when (>= %verbosity 3) + ;; FIXME-TRANSLATE(Krey) + (format #t "~ATarget file ~a~A~a has passed.~%~!" + (node-depth-string node) + (lquo) (node-get-name node) (rquo))) + (when (>= %verbosity 3) + ;; FIXME-TRANSLATE(Krey) + (format #t "~ATarget file ~a~A~a has failed.~%~!" + (node-depth-string node) + (lquo) (node-get-name node) (rquo))))))) + ;; else, children have failed + (begin + (when (>= %verbosity 3) + (format #t "~AThe prerequisites of target file ~a~A~a have failed.~%~!" + (node-depth-string node) (lquo) (node-get-name node) (rquo))) + (set-fail! node)))) + ;; else, children aren't complete + (begin + (when (>= %verbosity 3) + ;; FIXME-TRANSLATE(Krey) + (format #t "~AThe prerequisites of target file ~a~A~a are incomplete.~%~!" + (node-depth-string node) (lquo) (node-get-name node) (rquo))) + (let ((next (get-next-child node))) + (when (>= %verbosity 3) + ;; FIXME-TRANSLATE(Krey) + (format #t "~ADescending node ~a~A~a ~a ~a~A~a.~%~!" + (node-depth-string node) + (lquo) (node-get-name node) (rquo) + (right-arrow) + (lquo) (node-get-name next) (rquo))) + (set! node (get-next-child node)) + )))) + ;; else, this node is determined + (begin + (if (passed? node) + (when (>= %verbosity 2) + ;; FIXME-TRANSLATE(Krey) + (format #t "~A~a~A~a: ~APASS~A~%~!" + (node-depth-string node) (lquo) (node-get-name node) (rquo) + (green) (default))) + (when (>= %verbosity 2) + ;; FIXME-TRANSLATE(Krey) + (format #t "~A~a~A~a: ~AFAIL~A~%~!" + (node-depth-string node) (lquo) (node-get-name node) (rquo) + (red) (default)))) + (if (has-parent? node) + (begin + (when (>= %verbosity 3) + ;; FIXME-TRANSLATE(Krey) + (format #t "~AAscending node ~a~A~a ~a ~a~A~a.~%~!" + (node-depth-string node) + (lquo) (node-get-name node) (rquo) + (right-arrow) + (lquo) (node-get-name (node-get-parent node)) (rquo))) - (set! node (get-parent node))) - ;; else, there is no parent to this node - (begin - (when (>= %verbosity 3) - (format #t "~ATarget file ~a~A~a has no parent.~%~!" - (node-depth-string node) - (lquo) (node-get-name node) (rquo))) - (if (passed? node) - (when (>= %verbosity 1) - (format #t "~A~a~A~a: ~ACOMPLETE~A~%~!" - (node-depth-string node) - (lquo) (node-get-name node) (rquo) - (green) (default))) - (when (>= %verbosity 1) - (format #t "~A~a~A~a: ~ACOMPLETE~A~%~!" - (node-depth-string node) - (lquo) (node-get-name node) (rquo) - (red) (default)))) - (break))))))) + (set! node (get-parent node))) + ;; else, there is no parent to this node + (begin + (when (>= %verbosity 3) + ;; FIXME-TRANSLATE(Krey) + (format #t "~ATarget file ~a~A~a has no parent.~%~!" + (node-depth-string node) + (lquo) (node-get-name node) (rquo))) + (if (passed? node) + (when (>= %verbosity 1) + ;; FIXME-TRANSLATE(Krey) + (format #t "~A~a~A~a: ~ACOMPLETE~A~%~!" + (node-depth-string node) + (lquo) (node-get-name node) (rquo) + (green) (default))) + (when (>= %verbosity 1) + ;; FIXME-TRANSLATE(Krey) + (format #t "~A~a~A~a: ~ACOMPLETE~A~%~!" + (node-depth-string node) + (lquo) (node-get-name node) (rquo) + (red) (default)))) + (break))))))) ;; Return the command output of the root node (passed? tree))) + +;;; rules.scm ends here diff --git a/src/potato/text.scm b/src/potato/text.scm index 61e6069..2bed8f7 100644 --- a/src/potato/text.scm +++ b/src/potato/text.scm @@ -16,91 +16,113 @@ (define-module (potato text) #:export (underline - default - right-arrow - left-arrow - ellipses - C0 - red green - lquo - rquo - initialize-text)) + default + right-arrow + left-arrow + ellipses + C0 + red green + lquo + rquo + initialize-text)) + +;;; Commentary: +;;; +;;; File handling the text formatting in the repository +;;; +;;; Code: (define %fancy #t) (define (initialize-text ascii) + "FIXME-DOCS" (set! %fancy (not ascii))) (define (default) + "FIXME-DOCS" (if %fancy (string #\escape #\[ #\0 #\m) "")) -(define (bold) +(define (bold) + "FIXME-DOCS" (if %fancy (string #\escape #\[ #\1 #\m) "")) -(define (underline) +(define (underline) + "FIXME-DOCS" (if %fancy (string #\escape #\[ #\4 #\m) "")) (define (red) + "FIXME-DOCS" (if %fancy (string #\escape #\[ #\3 #\1 #\m) "")) (define (green) + "FIXME-DOCS" (if %fancy (string #\escape #\[ #\3 #\2 #\m) "")) (define (blue) + "FIXME-DOCS" (if %fancy (string #\escape #\[ #\3 #\4 #\m) "")) (define (important) + "FIXME-DOCS" (if %fancy "⚠" ; U+26A0 WARNING SIGN "!!!")) (define (stop) + "FIXME-DOCS" (if %fancy "🛑" ; U+26A0 WARNING SIGN "XXX")) (define (right-arrow) + "FIXME-DOCS" (if %fancy "→" "->")) (define (left-arrow) + "FIXME-DOCS" (if %fancy "←" "<-")) (define (ellipses) + "FIXME-DOCS" (if %fancy "…" "...")) (define (QED) + "FIXME-DOCS" (if %fancy "∎" "QED")) ; U+220E END OF PROOF (define (C0 c) + "FIXME-DOCS" (if %fancy ;; Replace control codes with control pictures (string (integer->char (+ #x2400 (char->integer c)))) (list-ref '("" "" "" "" "" "" - "" "" "" "" "" - "" "" "" "" "" - "" "" "" "" "" - "" "" "" "" "" - "" "" "" "" "" - "") - (char->integer c)))) + "" "" "" "" "" + "" "" "" "" "" + "" "" "" "" "" + "" "" "" "" "" + "" "" "" "" "" + "") + (char->integer c)))) (define (lquo) + "FIXME-DOCS" (if %fancy (string #\“) (string #\"))) (define (rquo) + "FIXME-DOCS" (if %fancy (string #\”) (string #\"))) (define (BOL) @@ -108,11 +130,11 @@ (if %fancy (string #\escape #\[ #\G) "\n")) #| -in quiet mode it is just +in quiet mode it is just ☐ target -> parent (when building) ☒ target -> parent (on pass) ⚠ target -> parent (on fail but continue) -🛑 target -> parent (on stop) +🛑 target -> parent (on stop) ∎ (on successful completion) in normal mode it is @@ -122,3 +144,5 @@ in normal mode it is then ☒ target -> parent (on pass) |# + +;; text.scm ends here