kreyren/pman
1
0
Fork 0
Code Issues 16 Pull Requests 2 Releases Activity

Quality Assurance, Audit and Tags #14

Merged
kreyren merged 11 commits from QAaudit into central 2022-09-03 10:35:10 +02:00
Conversation 13 Commits 11 Files Changed 33 +262 -252
17 changed files with 262 additions and 252 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit 66772f99e8 - Show all commits

3
pmake
View File

@ -1,3 +0,0 @@
#!/usr/bin/env sh
exec guile -L . -e '(@ (pmake main) main)' -s "$0" "$@"
!#

20
pman Executable file
View File

@ -0,0 +1,20 @@
#!/usr/bin/env sh
# shellcheck shell=sh # Written to comply with IEEE Std 1003.1-2017 (POSIX)
# The Project Manager ("pman") -- GNU Guile-based solution for project management
# Copyright (C) 2022 Jacob Hrbek <kreyren@rixotstudio.cz>
#
# This file is Free/Libre Open-Source Software; you may copy, redistribute and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 2 of the License, or (at your option) any later version.
# This file 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 GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public license along with this project. If not, see <http://www.gnu.org/licenses>
#
# This file incorporates work covered by the following copyright and permission notice:
#
# Copyright (C) 2017-2021 Mike Gran <spk121@yahoo.com>
#
# Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
exec guile -L . -e '(@ (pmake main) main)' -s "$0" "$@"
!#

3
make/main.scm → src/pmake/main.scm
View File

@ -20,11 +20,10 @@
;;; Commentary:
;;;
;;; Backend for the `pmake` command to process the command line arguments using the standardized 'getopts-long' as described in the GNU Guile reference manual <https://www.gnu.org/software/guile/manual/html_node/getopt_002dlong.html>.
;;; Backend for the `pman` command to process the command line arguments using the standardized 'getopts-long' as described in the GNU Guile reference manual <https://www.gnu.org/software/guile/manual/html_node/getopt_002dlong.html>.
;;;
;;; Code:
;; FIXME-QA(Krey): Is this even needed?
;; Declare exit codes
(define EXIT_SUCCESS 0)
(define EXIT_NOT_UP_TO_DATE 1)

0
make/zz-README.org → src/pmake/zz-README.org
View File

0
potato/zz-README.org~ → src/pmake/zz-README.org~
View File

45
potato/builtins.scm → src/potato/builtins.scm
View File

@ -16,13 +16,11 @@
(define-module (potato builtins)
#:export (builtin-makevars
; builtin-rules
))
#:export (builtin-makevars))
;;; Commentary:
;;;
;;; Declaration of the built-in functionality such as variables and helper rules
;;; Dedicated to the declaration of built-in functionality such as variables, rules, tasks, etc..
;;;
;;; Code:
@ -43,43 +41,4 @@
("GUILD" . "guild")
("GFLAGS" . "-W2")))
;; FIXME(Krey): This was commented out by the original author and it's use needs to be abstracted and re-implemented
#;(define builtin-rules
`((".c"
""
(,~ ,($ CC) ,($ CFLAGS) ,($ LDFLAGS) "-o" ,$@ ,$<))
(".f"
""
(,~ ,($ FC) ,($ FFLAGS) ,($ LDFLAGS) "-o" ,$@ ,$<))
(".sh"
""
(,~ "cp" ,$< ,$@)
(,~ "chmod a+x" ,$@))
(".c"
".o"
(,~ ,($ CC) ,($ CFLAGS) -c ,$<))
(".f"
".o"
(,~ ,($ FC) ,($ FFLAGS) -c ,$<))
(".y"
".o"
(,~ ,($ YACC) ,($ YFLAGS) ,$<))
(".l"
".o"
(,~ ,($ LEX) ,($ LFLAGS) ,$<)
(,~ ,($ CC) ,($ CFLAGS) "-c" lex.yy.c)
"rm -f lex.yy.c"
(,~ "mv lex.yy.o" ,$@))
(".y"
".c"
(,~ ,($ YACC) ,($ YFLAGS) ,$<)
(,~ "mv y.tab.c" ,$@))
(".l"
".c"
(,~ ,($ LEX) ,($ LDFLAGS) ,$<)
("mv lex.yy.c" ,$@))
(".scm"
".go"
(,~ ,($ GUILD) "compile" ,($ GFLAGS) ,$<))))
;;; builtins.scm ends here

31
potato/exceptions.scm → src/potato/exceptions.scm
View File

@ -14,7 +14,7 @@
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE
-(define-module (potato exceptions)
(define-module (potato exceptions)
#:use-module (ice-9 exceptions)
#:export (bad-key-type
bad-value-type
@ -22,30 +22,44 @@
invalid-macro
not-a-regular-file
not-a-procedure
no-read-access-to-file
))
no-read-access-to-file))
;;; Commentary:
;;;
;;; Dedicated to handling 'exceptions' as in termination of the program
;;;
;;; Code:
;; FIXME-QA(Krey): This code is using 'bad' which is hard to understand without context, thus should be changed on 'unexpected'
(define (make-bad-key-type origin irritants)
"Exception used when bad key is parsed to 'make' functionality"
(make-exception
(make-programming-error)
(make-exception-with-origin origin)
;; FIXME-TRANSLATE(Krey)
(make-exception-with-message "Wrong type for key. Expecting string or procedure.")
(make-exception-with-irritants irritants)))
(define (bad-key-type origin irritant)
"Generic exception for unexpected key"
(raise-exception (make-bad-key-type origin irritant)))
(define (make-bad-value-type origin irritants)
"Exception for unexpected value in the 'make' functionality"
(make-exception
(make-programming-error)
(make-exception-with-origin origin)
;; FIXME-TRANSLATE(Krey)
(make-exception-with-message "Wrong type for value. Expecting string or procedure.")
(make-exception-with-irritants irritants)))
(define (bad-value-type origin irritant)
"Generic exception for unexpected value"
(raise-exception (make-bad-value-type origin irritant)))
(define (make-bad-proc-output origin irritants)
"Exception for unexpected process output in 'make' functionality"
(make-exception
(make-programming-error)
(make-exception-with-origin origin)
@ -53,9 +67,11 @@
(make-exception-with-irritants irritants)))
(define (bad-proc-output origin irritant)
"Generic exception for unexpected process output"
(raise-exception (make-bad-proc-output origin irritant)))
(define (make-invalid-macro origin irritants)
"Exception for invalid macro in 'make' functionality"
(make-exception
(make-programming-error)
(make-exception-with-origin origin)
@ -63,9 +79,11 @@
(make-exception-with-irritants irritants)))
(define (invalid-macro origin irritant)
"Generic exception for invalid macro"
(raise-exception (make-invalid-macro origin irritant)))
(define (make-not-a-regular-file origin irritants)
"Exception for not regular file in 'make' functionality"
(make-exception
(make-programming-error)
(make-exception-with-origin origin)
@ -73,9 +91,11 @@
(make-exception-with-irritants irritants)))
(define (not-a-regular-file origin irritant)
"Generic exception for when regular file is not parsed"
(raise-exception (make-not-a-regular-file origin irritant)))
(define (make-not-a-procedure origin irritants)
"Exception for when regular file is not parsed in the 'make' functionality"
(make-exception
(make-programming-error)
(make-exception-with-origin origin)
@ -83,9 +103,11 @@
(make-exception-with-irritants irritants)))
(define (not-a-procedure origin irritant)
"Generic exception for when procedure is not parsed"
(raise-exception (make-not-a-procedure origin irritant)))
(define (make-no-read-access-to-file origin irritants)
"Exception for when we don't have the expected read access to the file in 'make' functionality"
(make-exception
(make-programming-error)
(make-exception-with-origin origin)
@ -93,4 +115,7 @@
(make-exception-with-irritants irritants)))
(define (no-read-access-to-file origin irritant)
"Generic exception for when we don't have the excepted read access to the file"
(raise-exception (make-no-read-access-to-file origin irritant)))
;;; exceptions.scm end here

54
potato/make.scm → src/potato/make.scm
View File

@ -29,7 +29,6 @@
#:re-export (%suffix-rules
lazy-assign ?=
assign :=
;; WTF(Krey): Why is the 'Q' here?
reference $ Q
reference-func $$
target-rule :
@ -47,26 +46,21 @@
;;; Commentary:
;;;
;;; TBD
;;; Entry file to the project, designed for handling the functionality
;;;
;;; Code:
;; FIXME-QA(Krey): This file includes debugging utilities that should be exported into a standalone library to make this software more maintainable
;; FIXME-QA(Krey): Needs refactor
;; FIXME-QA(Krey): Why is this here?
;; 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 :=
;; ref $
;; target-rule :
;; suffix-rule ->
;; compose ~
;; ))
;; FIXME-DOCS(Krey): Lacks context
;;; Asynchronous events.
;;; SIGHUP, SIGTERM, SIGINT and SIGQUIT remove the current target
;;; unless that target is a directory or the target is a prerequisite
@ -88,27 +82,31 @@
;;; If the -t option was specified, make shall write to standard
;;; output a message for each file that was touched.
;;; Output handlers
;;; These handlers are designed to be used for debug management
;; Verbosity is 0 = silent, 1 = terse, 2 = default, 3 = verbose
(define %verbosity 2)
;; WTF(Krey)
;; WTF(Krey): Option to set verbose output and %verbosity defining the "deepness" of output?
(define %opt-verbose #f)
;; WTF(Krey)
;; WTF(Krey): Option to ignore errors?
(define %opt-ignore-errors #f)
;; WTF(Krey)
;; WTF(Krey): Option to continue on errors?
(define %opt-continue-on-error #f)
;; WTF(Krey)
;; WTF(Krey): Generic definition of targets for appending?
(define %targets '())
;; WTF(Krey)
;; WTF(Krey): No idea
(define %initialized #f)
;; Output handlers
(define (critical spec . args)
"Output to handle 'cricital' output messages"
(apply format (append (list #t spec) args)))
;; FIXME-QA(Krey): The 'print' is too generic, should we rename it?
(define (print spec . args)
"Output to handle printing of output. Only works when verbosity is set to 2 and higher"
(when (>= %verbosity 2)
(apply format (append (list #t spec) args))))
(define (debug spec . args)
"Output to handle level 3 debug messages"
(when (>= %verbosity 3)
(apply format (append (list #t spec) args))))
@ -127,6 +125,7 @@
;; FIXME-QA(Krey): This is calling `format` multiple times to print one line which is resource inefficient
(define (display-help-and-exit argv0)
"Function used to output help message and exit"
(format #t "~A [-hvqVeEbn] [KEY=VALUE ...] [targets ...]~%" argv0)
(format #t " -h, --help print help and exit~%")
(format #t " -v, --version print version and exit~%")
@ -148,11 +147,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))
;; FIXME-QA(Krey): Why is this accepting input?
(define (display-version-and-exit argv0)
"Procedure to output the project version and exit"
"Function to output the project version and exit"
(format #t "~a~%" argv0)
(format #t " using potato make~a~%" %version)
(exit 0))
@ -173,8 +172,7 @@ of pairs of KEY VAL"
lst))
(define (parse-targets lst)
"Search the list for strings that don't have equals signs, and
return them in a list."
"Search the list for strings that don't have equals signs, and return them in a list."
(filter-map
(lambda (str)
(if (string-index str #\=)
@ -184,13 +182,7 @@ return them in a list."
(define* (initialize #:optional
(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
expected to be a list of strings that are command-line
arguments."
;; If left unset, assume user want all the command line arguments.
"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 expected to be a list of strings that are command-line arguments." ;; If left unset, assume user want all the command line arguments.
(when (not arguments)
(set! arguments (command-line)))
;; If the user has set it to '(), expecting a null environment, add
@ -284,9 +276,7 @@ arguments."
%opt-no-execution
%verbosity
%opt-ascii)
(set! %initialized #t)
%targets
)))
(set! %initialized #t) %targets)))
(define* (execute #:key (targets '()))
"This function runs build actions. TARGETS, if provided, is a list

357
potato/makevars.scm → src/potato/makevars.scm
View File

@ -21,46 +21,66 @@
#:use-module (potato builtins)
#:use-module (potato text)
#:export (initialize-makevars
%makevars
%elevate-environment?
lazy-assign ?=
assign :=
reference $ Q
reference-func $$
dump-makevars
))
%makevars
%elevate-environment?
lazy-assign ?=
assign :=
reference $ Q
reference-func $$
dump-makevars))
;;; Commentary:
;;;
;;; Used to handle the 'makevars' functionality meaning assigning and managing environmental variables into variables used by guile
;;;
;;; Code:
;; Defines the priority level
;; There are five priority levels
;; 1. defined - in the script itself
;; 2. command-line
;; 3. makeflags - in the MAKEFLAGS environment variable
;; 4. env - specified in the environment
;; 5. built-in - one of the built-in macros
;; 1. defined - in the script itself
;; 2. command-line
;; 3. makeflags - in the MAKEFLAGS environment variable
;; 4. env - specified in the environment
;; 5. built-in - one of the built-in macros
;;
;; The lower priority level always win, unless the '-e' flag was set
;; If the '-e' flag is set level 1 doesn't override level 3 and 4.
(define %level-name '("unknown"
"script"
"command-line"
"makeflags"
"environment"
"built-in"))
(define %level-name '("unknown" "script" "command-line" "makeflags" "environment" "built-in"))
;; WTF(Krey): No fucking idea.. something with ASCII? If ASCII is supported?
(define %ascii? #f)
;; WTF(Krey)
(define %makevars (make-hash-table))
;; WTF(Krey)
(define %elevate-environment? #f)
;; WTF(Krey)
(define %strict #f)
;; WTF(Krey)
(define %verbose? #t)
;; WTF(Krey)
(define (debug spec . args)
"Output to handle debugging messages"
(when %verbose?
(apply format (append (list #t spec) args))))
(define (split-at-equals str)
"Splits the string at the first equals sign, ignoring
later equals signs."
"Splits the string at the first equals sign, ignoring later equals signs."
(let ((idx (string-index str #\=)))
(if (and idx (> idx 0))
(cons (substring str 0 idx)
(substring str (1+ idx)))
;; else
#f)))
(cons (substring str 0 idx)
(substring str (1+ idx)))
;; else
#f)))
(define (string-append-with-spaces lst)
"Appends the strings in lst, adding spaces in between."
@ -75,69 +95,66 @@ later equals signs."
others."
(if %elevate-environment?
(if (and (or (= old-priority 2) (= old-priority 3) (= old-priority 4))
(= new-priority 1))
#f
;; else
(<= new-priority old-priority))
(= new-priority 1))
#f
;; else
(<= new-priority old-priority))
;; else
(<= new-priority old-priority)))
(define* (makevars-set key
#:optional (new-val "") (new-priority 1))
#:optional (new-val "") (new-priority 1))
"Maybe add key / val to %makevars hash table, if there is sufficient
priority."
;; Note that VAL can be either a string or a procedure. If it is a
;; procedure, it is converted into a promise to be evaluated later.
(let* ((val&priority (hash-ref %makevars key))
(old-val (if (pair? val&priority) (cdr val&priority) #f))
(old-priority (if (pair? val&priority) (cdr val&priority) #f)))
(old-val (if (pair? val&priority) (cdr val&priority) #f))
(old-priority (if (pair? val&priority) (cdr val&priority) #f)))
(when (or (not old-val)
(override? old-priority new-priority))
(override? old-priority new-priority))
(if (procedure? new-val)
(hash-set! %makevars key (cons (delay new-val) new-priority))
(hash-set! %makevars key (cons new-val new-priority)))
(hash-set! %makevars key (cons (delay new-val) new-priority))
(hash-set! %makevars key (cons new-val new-priority)))
(when %verbose? (print-makevar key))))
*unspecified*)
(define (makevars-add-keyvals keyvals)
"Adds any suitable macros passed in from the command line, which
here are expected to be a list of key / val string pairs."
"Adds any suitable macros passed in from the command line, which here are expected to be a list of key / val string pairs."
(for-each
(lambda (entry)
(let ((key (car entry))
(val (cdr entry)))
(val (cdr entry)))
(unless (or (string=? key "SHELL")
(string=? key "MAKEFLAGS"))
(makevars-set key val 2))))
(string=? key "MAKEFLAGS"))
(makevars-set key val 2))))
keyvals))
(define (makevars-add-makeflags)
"Adds any suitable environment variables found in the MAKEFLAGS
environment variable to the macro store"
"Adds any suitable environment variables found in the MAKEFLAGS environment variable to the macro store"
(let ((makeflags (getenv "MAKEFLAGS")))
(when makeflags
(for-each
(lambda (entry)
(let* ((keyval (split-at-equals entry))
(key (if keyval (car keyval) #f))
(val (if keyval (cdr keyval) #f)))
(unless (or (not (string? key))
(string=? key "SHELL")
(string=? key "MAKEFLAGS"))
(makevars-set key val 3))))
(let* ((keyval (split-at-equals entry))
(key (if keyval (car keyval) #f))
(val (if keyval (cdr keyval) #f)))
(unless (or (not (string? key))
(string=? key "SHELL")
(string=? key "MAKEFLAGS"))
(makevars-set key val 3))))
(string-split makeflags #\space)))))
(define (makevars-add-environment)
"Adds any suitable environment variables to the macro store, but not
the value of MAKEFLAGS or SHELL."
"Adds any suitable environment variables to the macro store, but not the value of MAKEFLAGS or SHELL."
(for-each
(lambda (entry)
(let* ((keyval (split-at-equals entry))
(key (if keyval (car keyval) #f))
(val (if keyval (cdr keyval) #f)))
(key (if keyval (car keyval) #f))
(val (if keyval (cdr keyval) #f)))
(unless (or (string=? key "SHELL")
(string=? key "MAKEFLAGS"))
(makevars-set key val 4))))
(string=? key "MAKEFLAGS"))
(makevars-set key val 4))))
(environ)))
(define (makevars-add-builtins)
@ -147,44 +164,45 @@ the value of MAKEFLAGS or SHELL."
(makevars-set (car keyval) (cdr keyval) 5))
builtin-makevars))
;; FIXME-DOCS(Krey)
(define (print-makevar key)
(let ((val (hash-ref %makevars key)))
(let ((keyval-string
(if (zero? (string-length (car val)))
(string-copy key)
(string-append key " " (right-arrow) " " (car val)))))
(if (zero? (string-length (car val)))
(string-copy key)
(string-append key " " (right-arrow) " " (car val)))))
;; Replace any control characters in VAL, like newline or tab
(set! keyval-string
(string-fold
(lambda (c str)
(string-append str
(if (char<? c #\space)
(C0 c)
(string c))))
""
keyval-string))
(string-fold
(lambda (c str)
(string-append str
(if (char<? c #\space)
(C0 c)
(string c))))
""
keyval-string))
;; Truncate
(if (> (string-length keyval-string) 60)
(if %ascii?
(set! keyval-string
(string-append (substring keyval-string 0 57) "..."))
(set! keyval-string
(string-append (substring keyval-string 0 59) "…"))))
(if %ascii?
(set! keyval-string
(string-append (substring keyval-string 0 57) "..."))
(set! keyval-string
(string-append (substring keyval-string 0 59) "…"))))
(let* ((space (make-string (- 64 (string-length keyval-string))
#\space))
(priority (cdr val))
(source-string (list-ref '("unknown"
"script"
"command line"
"MAKEFLAGS"
"environment"
"built-in")
priority)))
(display "Var: ")
(display keyval-string)
(display space)
(display source-string)
(newline)))))
#\space))
(priority (cdr val))
(source-string (list-ref '("unknown"
"script"
"command line"
"MAKEFLAGS"
"environment"
"built-in")
priority)))
(display "Var: ")
(display keyval-string)
(display space)
(display source-string)
(newline)))))
(define (dump-makevars)
"Write out a list of the current makevars."
@ -194,59 +212,60 @@ the value of MAKEFLAGS or SHELL."
(display (default))
(newline)
(let ((keyvals
(sort
(hash-map->list cons %makevars)
(lambda (a b)
(string<? (car a) (car b))))))
(sort
(hash-map->list cons %makevars)
(lambda (a b)
(string<? (car a) (car b))))))
(for-each
(lambda (keyval)
(let ((key (car keyval))
(val (cdr keyval)))
(let ((keyval-string
(if (zero? (string-length (car val)))
(string-copy key)
(string-append key " " (right-arrow) " " (car val)))))
;; Replace any control characters in VAL, like newline or tab
(set! keyval-string
(string-fold
(lambda (c str)
(string-append str
(if (char<? c #\space)
(C0 c)
(string c))))
""
keyval-string))
;; Truncate
(if (> (string-length keyval-string) 60)
(if %ascii?
(set! keyval-string
(string-append (substring keyval-string 0 57) "..."))
(set! keyval-string
(string-append (substring keyval-string 0 59) "…"))))
(let* ((space (make-string (- 64 (string-length keyval-string))
#\space))
(priority (cdr val))
(source-string (list-ref '("unknown"
"script"
"command line"
"MAKEFLAGS"
"environment"
"built-in")
priority)))
(display " ")
(display keyval-string)
(display space)
(display source-string)
(newline)))))
keyvals))))
(let ((key (car keyval))
(val (cdr keyval)))
(let ((keyval-string
(if (zero? (string-length (car val)))
(string-copy key)
(string-append key " " (right-arrow) " " (car val)))))
;; Replace any control characters in VAL, like newline or tab
(set! keyval-string
(string-fold
(lambda (c str)
(string-append str
(if (char<? c #\space)
(C0 c)
(string c))))
""
keyval-string))
;; Truncate
(if (> (string-length keyval-string) 60)
(if %ascii?
(set! keyval-string
(string-append (substring keyval-string 0 57) "..."))
(set! keyval-string
(string-append (substring keyval-string 0 59) "…"))))
(let* ((space (make-string (- 64 (string-length keyval-string))
#\space))
(priority (cdr val))
(source-string (list-ref '("unknown"
"script"
"command line"
"MAKEFLAGS"
"environment"
"built-in")
priority)))
(display " ")
(display keyval-string)
(display space)
(display source-string)
(newline)))))
keyvals))))
;; FIXME-DOCS(Krey)
(define (initialize-makevars keyvals
environment?
elevate-environment?
builtins?
strict?
verbosity
ascii?)
environment?
elevate-environment?
builtins?
strict?
verbosity
ascii?)
(set! %elevate-environment? elevate-environment?)
(hash-clear! %makevars)
(set! %strict strict?)
@ -316,13 +335,13 @@ or a procedure that evaluates to a string.
in the hash table was a *promise* it will be forced,
evaluated, and set to that result.
If no transformer is supplied, the looked up value will be
returned.
returned.
TRANSFORMER, if
supplied, should be a procedure of one string argument that returns a
string. If a transformer is supplied, it will be applied to every
space-separated token in the looked-up value."
(when (and (not (string? key))
(not (procedure? key)))
(not (procedure? key)))
(bad-key-type "reference" (list key)))
(when (procedure? key)
(set! key (key))
@ -331,42 +350,42 @@ space-separated token in the looked-up value."
(when (not (string? key))
(set! key (format #t "~a" key)))
(let* ((val&priority (hash-ref %makevars key))
(val (if (pair? val&priority) (car val&priority) #f))
(priority (if (pair? val&priority) (cdr val&priority) #f)))
(val (if (pair? val&priority) (car val&priority) #f))
(priority (if (pair? val&priority) (cdr val&priority) #f)))
(if (not val)
(if %strict
(error (format #t "There is no makevar for key ~a~%~!" key))
;; else
(if quoted?
"\"\""
""))
;; else
(begin
(cond
((promise? val)
(set! val (force val))
(cond
((string? val)
;; noop
#t)
((procedure? val)
(set! val (val)))
(else
(set! val (format #f "~a" val)))))
((string? val)
;; noop
#f)
(else
(set! val (format #f "~a" val))))
(hash-set! %makevars key (cons val priority))
(when %verbose? (print-makevar key))
(when (procedure? transformer)
(set! val (string-append-with-spaces
(map transformer
(string-tokenize val)))))
(if quoted?
(string-append "\"" val "\"")
val)))))
(if %strict
(error (format #t "There is no makevar for key ~a~%~!" key))
;; else
(if quoted?
"\"\""
""))
;; else
(begin
(cond
((promise? val)
(set! val (force val))
(cond
((string? val)
;; noop
#t)
((procedure? val)
(set! val (val)))
(else
(set! val (format #f "~a" val)))))
((string? val)
;; noop
#f)
(else
(set! val (format #f "~a" val))))
(hash-set! %makevars key (cons val priority))
(when %verbose? (print-makevar key))
(when (procedure? transformer)
(set! val (string-append-with-spaces
(map transformer
(string-tokenize val)))))
(if quoted?
(string-append "\"" val "\"")
val)))))
(define-syntax $
(lambda (stx)

0
potato/parse-lib.scm → src/potato/parse-lib.scm
View File

0
potato/parse.scm → src/potato/parse.scm
View File

0
potato/parser.scm → src/potato/parser.scm
View File

0
potato/rules.scm → src/potato/rules.scm
View File

0
potato/text.scm → src/potato/text.scm
View File

0
potato/zz-README.org → src/potato/zz-README.org
View File

0
src/potato/zz-README.org~ Normal file
View File

1
src/zz-README.org Normal file
View File

@ -0,0 +1 @@
Source code of the project