From 0bc136cf3ac642cdf23854da2d36669cbdf40663 Mon Sep 17 00:00:00 2001 From: Jacob Hrbek Date: Sun, 28 Aug 2022 20:02:07 +0200 Subject: [PATCH] Sync Signed-off-by: Jacob Hrbek --- make/main.scm | 2 +- potato/exceptions.scm | 14 +-- potato/make.scm | 242 +++++++++++++++++++++++------------------- potato/zz-README.org~ | 0 4 files changed, 143 insertions(+), 115 deletions(-) create mode 100644 potato/zz-README.org~ diff --git a/make/main.scm b/make/main.scm index 0e65498..ed16aea 100644 --- a/make/main.scm +++ b/make/main.scm @@ -14,7 +14,7 @@ ;;; Commentary: ;;; -;;; This file is designed to process the command line arguments using the standardized 'getopts-long' as described in the GNU Guile reference manual . +;;; Backend for the `pmake` command to process the command line arguments using the standardized 'getopts-long' as described in the GNU Guile reference manual . ;;; ;;; Code: diff --git a/potato/exceptions.scm b/potato/exceptions.scm index 1eed9f6..f08d224 100644 --- a/potato/exceptions.scm +++ b/potato/exceptions.scm @@ -1,13 +1,13 @@ -(define-module (potato exceptions) #:use-module (ice-9 exceptions) #:export (bad-key-type - bad-value-type - bad-proc-output - invalid-macro - not-a-regular-file - not-a-procedure - no-read-access-to-file - )) + bad-value-type + bad-proc-output + invalid-macro + not-a-regular-file + not-a-procedure + no-read-access-to-file + )) (define (make-bad-key-type origin irritants) (make-exception diff --git a/potato/make.scm b/potato/make.scm index 298fa52..f12f445 100644 --- a/potato/make.scm +++ b/potato/make.scm @@ -1,3 +1,13 @@ +;;; The Project Manager ("pman") -- GNU Guile-based solution for project management +;;; Copyright (C) 2021 Mike Gran +;;; Copyright (C) 2022 Jacob Hrbek +;;; +;;; The Project Manager is a Free/Libre Open-Source Software; you can redistribute it and/or modify it under the terms of the MIT License as published by the Massachusetts Institute of Technology +;;; +;;; This project is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the MIT License for more details. +;;; +;;; You should have received a copy of the MIT License along with the project. If not, see . + (define-module (potato make) #:use-module (srfi srfi-1) #:use-module (ice-9 exceptions) @@ -9,30 +19,39 @@ #:use-module (potato makevars) #:use-module (potato rules) #:use-module (potato text) - #:export (initialize - execute) + #:export (initialize execute) #:re-export (%suffix-rules - lazy-assign ?= - assign := - reference $ Q - reference-func $$ - target-rule : - suffix-rule -> - target-name $@ - target-basename $* - newer-prerequisites $? $$? - prerequisites $^ $$^ - primary-prerequisite $< - string-compose ~ - silent-compose ~@ - always-execute-compose ~+ - ignore-error-compose ~- - install-alternate-system-driver - )) + lazy-assign ?= + assign := + ;; WTF(Krey): Why is the 'Q' here? + reference $ Q + reference-func $$ + target-rule : + suffix-rule -> + target-name $@ + target-basename $* + newer-prerequisites $? $$? + prerequisites $^ $$^ + primary-prerequisite $< + string-compose ~ + silent-compose ~@ + always-execute-compose ~+ + ignore-error-compose ~- + install-alternate-system-driver)) +;;; Commentary: +;;; +;;; TBD +;;; +;;; Code: + +;; Project version (define %version "1.0") + +;; WTF(Krey) (define %debug-argv0 #f) +;; WTF(Krey): Was commented out by the original author.. no idea why ;; #:re-export ( ;; lazy-assign ?= ;; assign := @@ -42,37 +61,44 @@ ;; compose ~ ;; )) -;; Asynchronous events. -;; SIGHUP, SIGTERM, SIGINT and SIGQUIT remove the current target -;; unless that target is a directory or the target is a prerequisite -;; of .PRECIOUS or the -n, -q, or -p option was specified. This -;; deletion shall be reported to the error port, then the default for -;; that action will continue. +;;; Asynchronous events. +;;; SIGHUP, SIGTERM, SIGINT and SIGQUIT remove the current target +;;; unless that target is a directory or the target is a prerequisite +;;; of .PRECIOUS or the -n, -q, or -p option was specified. This +;;; deletion shall be reported to the error port, then the default for +;;; that action will continue. -;; .SILENT -;; The utility shall write all commands to the standard output unless -;; the -s option was specified, the command is prefixed with +, or -;; .SILENT has the current target as a prerequisite or has no pre -;; requisites. +;;; .SILENT +;;; The utility shall write all commands to the standard output unless +;;; the -s option was specified, the command is prefixed with +, or +;;; .SILENT has the current target as a prerequisite or has no pre +;;; requisites. -;; Nothing to be done -;; If make was invoked but found no work to do, it shall write a -;; message to standard output that no action was taken +;;; Nothing to be done +;;; If make was invoked but found no work to do, it shall write a +;;; message to standard output that no action was taken -;; File Touched -;; If the -t option was specified, make shall write to standard -;; output a message for each file that was touched. +;;; File Touched +;;; If the -t option was specified, make shall write to standard +;;; output a message for each file that was touched. ;; Verbosity is 0 = silent, 1 = terse, 2 = default, 3 = verbose (define %verbosity 2) +;; WTF(Krey) (define %opt-verbose #f) +;; WTF(Krey) (define %opt-ignore-errors #f) +;; WTF(Krey) (define %opt-continue-on-error #f) +;; WTF(Krey) (define %targets '()) +;; WTF(Krey) (define %initialized #f) +;; Output handlers (define (critical spec . args) (apply format (append (list #t spec) args))) +;; FIXME-QA(Krey): The 'print' is too generic, should we rename it? (define (print spec . args) (when (>= %verbosity 2) (apply format (append (list #t spec) args)))) @@ -91,15 +117,15 @@ (continue-on-error (single-char #\k) (value #f)) (no-execution (single-char #\n) (value #f)) (ascii (single-char #\A) (value #f)) - (strict (single-char #\S) (value #f)) - )) + (strict (single-char #\S) (value #f)))) +;; FIXME-QA(Krey): This is calling `format` multiple times to print one line which is resource inefficient (define (display-help-and-exit argv0) (format #t "~A [-hvqVeEbn] [KEY=VALUE ...] [targets ...]~%" argv0) (format #t " -h, --help print help and exit~%") (format #t " -v, --version print version and exit~%") (format #t " -V 0..3, --verbosity=0..3~%") - (format #t " set output level from 0=silent to 3=verbose~%") + (format #t " set output level from 0=silent to 3=verbose~%") (format #t " -e, --environment use environment variables~%") (format #t " -E, --elevate-environment~%") (format #t " use environment variables and let~%") @@ -116,9 +142,11 @@ (format #t " ASCII only output and no colors~%") (format #t " -S, --strict~%") (format #t " causes some behaviours to throw errors~%") + ;; FIXME-QA(Krey): 'exit'? It should be using 'throw' (exit 0)) (define (display-version-and-exit argv0) + "Procedure to output the project version and exit" (format #t "~a~%" argv0) (format #t " using potato make~a~%" %version) (exit 0)) @@ -130,12 +158,12 @@ of pairs of KEY VAL" (lambda (str) (let ((tok (string-split str #\=))) (cond - ((= 1 (length tok)) - #f) - ((= 2 (length tok)) - (cons (car tok) (cadr tok))) - (else - (invalid-macro "parse-macros" str))))) + ((= 1 (length tok)) + #f) + ((= 2 (length tok)) + (cons (car tok) (cadr tok))) + (else + (invalid-macro "parse-macros" str))))) lst)) (define (parse-targets lst) @@ -144,12 +172,12 @@ return them in a list." (filter-map (lambda (str) (if (string-index str #\=) - #f - str)) + #f + str)) lst)) (define* (initialize #:optional - (arguments #f)) + (arguments #f)) "Set up the options, rules, and makevars. If ARGUMENTS is not set, it will use options, makevars, and targets as specified by the command line. If it is set, it is @@ -166,14 +194,14 @@ arguments." ;; We start of with the --help and --version command-line arguments. (let ((options (getopt-long arguments option-spec)) - (%opt-builtins #f) - (%opt-environment #f) - (%opt-elevate-environment #f) - (%opt-no-errors #f) - (%opt-continue-on-error #f) - (%opt-no-execution #f) - (%opt-ascii #f) - (%opt-strict #f)) + (%opt-builtins #f) + (%opt-environment #f) + (%opt-elevate-environment #f) + (%opt-no-errors #f) + (%opt-continue-on-error #f) + (%opt-no-execution #f) + (%opt-ascii #f) + (%opt-strict #f)) (when (option-ref options 'help #f) (display-help-and-exit (car arguments))) (when (option-ref options 'version #f) @@ -188,32 +216,32 @@ arguments." ;; command-line options to override MAKEFLAGS options. (when %opt-environment (let ((mf (getenv "MAKEFLAGS"))) - (when mf - (let ((tokens (string-tokenize mf))) - (when (member "silent" tokens) - (set! %verbosity 0)) - (when (member "terse" tokens) - (set! %verbosity 1)) - (when (member "verbose" tokens) - (set! %verbosity 3)) - (when (member "builtins" tokens) - (set! %opt-builtins #t)) - (when (member "ascii" tokens) - (set! %opt-ascii #t)) - (when (member "ignore-errors" tokens) - (set! %opt-ignore-errors #t)) - (when (member "continue-on-error" tokens) - (set! %opt-continue-on-error #t)) - (when (member "strict" tokens) - (set! %opt-strict #t)) - (when (member "no-execution" tokens) - (set! %opt-no-execution #t)))))) + (when mf + (let ((tokens (string-tokenize mf))) + (when (member "silent" tokens) + (set! %verbosity 0)) + (when (member "terse" tokens) + (set! %verbosity 1)) + (when (member "verbose" tokens) + (set! %verbosity 3)) + (when (member "builtins" tokens) + (set! %opt-builtins #t)) + (when (member "ascii" tokens) + (set! %opt-ascii #t)) + (when (member "ignore-errors" tokens) + (set! %opt-ignore-errors #t)) + (when (member "continue-on-error" tokens) + (set! %opt-continue-on-error #t)) + (when (member "strict" tokens) + (set! %opt-strict #t)) + (when (member "no-execution" tokens) + (set! %opt-no-execution #t)))))) ;; Now the bulk of the command-line options. (when (option-ref options 'verbosity #f) (let ((verbosity (string->number (option-ref options 'verbosity #f)))) - (when verbosity - (set! %verbosity verbosity)))) + (when verbosity + (set! %verbosity verbosity)))) (when (option-ref options 'builtins #f) (set! %opt-builtins #t)) (when (option-ref options 'elevate-environment #f) @@ -234,22 +262,22 @@ arguments." (let ((extra (option-ref options '() '()))) (initialize-text %opt-ascii) (initialize-makevars (parse-macros extra) - %opt-environment - %opt-elevate-environment - %opt-builtins - %opt-strict - %verbosity - %opt-ascii) + %opt-environment + %opt-elevate-environment + %opt-builtins + %opt-strict + %verbosity + %opt-ascii) ;; The remaining command-line words are the build targets that ;; we're going to tackle. (set! %targets (parse-targets extra)) (initialize-rules %targets - %opt-builtins - %opt-ignore-errors - %opt-continue-on-error - %opt-no-execution - %verbosity - %opt-ascii) + %opt-builtins + %opt-ignore-errors + %opt-continue-on-error + %opt-no-execution + %verbosity + %opt-ascii) (set! %initialized #t) %targets ))) @@ -269,27 +297,27 @@ targets listed on the parsed command-line are used." (debug "No build target was explicitely specified.~%") (let ((rule (first-target-rule-name))) (if rule - (begin - (debug "Using first rule ~a~A~a as the build target.~%" (lquo) rule (rquo)) - (set! targets (list rule))) - ;; else - (debug "There are no target rules in the recipe.~%")))) + (begin + (debug "Using first rule ~a~A~a as the build target.~%" (lquo) rule (rquo)) + (set! targets (list rule))) + ;; else + (debug "There are no target rules in the recipe.~%")))) ;; Build each target in order. (when (not (null? targets)) (let loop ((target (car targets)) - (rest (cdr targets))) + (rest (cdr targets))) (if (not (build target)) - (begin - (print "The recipe for “~A” has failed.~%" target) - #f) - ;; else - (begin - (print "The recipe “~A” finished successfully.~%" target) - (if (not (null? rest)) - (loop (car rest) (cdr rest)) + (begin + (print "The recipe for “~A” has failed.~%" target) + #f) + ;; else + (begin + (print "The recipe “~A” finished successfully.~%" target) + (if (not (null? rest)) + (loop (car rest) (cdr rest)) - ;; True if all targets are built successfully. - #t)))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; True if all targets are built successfully. + #t)))))) +;;; make.scm ends here diff --git a/potato/zz-README.org~ b/potato/zz-README.org~ new file mode 100644 index 0000000..e69de29