Signed-off-by: Jacob Hrbek <kreyren@rixotstudio.cz>
This commit is contained in:
Jacob Hrbek 2022-08-30 16:53:18 +02:00
parent 66772f99e8
commit ddb3640fb8
Signed by: kreyren
GPG Key ID: 667F0DAFAF09BA2B
4 changed files with 191 additions and 203 deletions

10
.gitignore vendored

@ -1,7 +1,3 @@
*.ss~
*.ss#*
.#*.ss
*.scm~
*.scm#*
.#*.scm
# Emacs teporary files
**~
**\#

@ -278,15 +278,14 @@ priority."
(makevars-add-makeflags))
(makevars-add-keyvals keyvals))
;; API
;;; API
(define* (lazy-assign key #:optional (val ""))
"This procedure sets an entry in the %makevars hash table.
KEY must be a string or a thunk that evaluates to a string. Likewise
VAL.
If KEY is a thunk, it is immediately evaluated to a string to use as
the key in the hash table entry.
If VAL is a thunk, it is stored as a *promise* to be evaluated
later. The promise will be evaluated the first time this key is
If KEY is a thunk, it is immediately evaluated to a string to use as the key in the hash table entry.
If VAL is a thunk, it is stored as a *promise* to be evaluated later. The promise will be evaluated the first time this key is
referenced.
If VAL is not given, the empty string will be used."
(when (procedure? key)
@ -307,8 +306,7 @@ referenced.
"This procedure sets an entry in the %makevars hash table.
KEY must be a string or a thunk that evaluates to a string. Likewise
VAL.
If KEY and/or VAL is a thunk, it is immediately evaluated to a
string to use as the key in the hash table entry.
If KEY and/or VAL is a thunk, it is immediately evaluated to a string to use as the key in the hash table entry.
If VAL is not given, the empty string will be used."
(when (procedure? key)
(set! key (key)))
@ -331,15 +329,9 @@ string to use as the key in the hash table entry.
(define* (reference key quoted? #:optional (transformer #f))
"Looks up KEY in the %makevars hash table. KEY may be a string
or a procedure that evaluates to a string.
If the value of the key
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.
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."
If the value of the key 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.
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)))
(bad-key-type "reference" (list key)))
@ -387,6 +379,7 @@ space-separated token in the looked-up value."
(string-append "\"" val "\"")
val)))))
;; FIXME-DOCS(Krey)
(define-syntax $
(lambda (stx)
(syntax-case stx ()
@ -395,6 +388,7 @@ space-separated token in the looked-up value."
((_ key)
#'(reference (symbol->string (syntax->datum #'key)) #f)))))
;; FIXME-DOCS(Krey)
(define-syntax Q
(lambda (stx)
(syntax-case stx ()
@ -404,13 +398,9 @@ space-separated token in the looked-up value."
#'(reference (symbol->string (syntax->datum #'key)) #t)))))
(define (reference-func key)
"Looks up KEY in the %makevars hash table. KEY shall be a string
or a procedure that evaluates to a string.
If the value of the key
in the hash table was a *promise*, a procedure will be returned that,
when called, will call that promise. If the value of the key is
a string, a procedure will be returned that, when called, returns
that string."
"Looks up KEY in the %makevars hash table. KEY shall be a string or a procedure that evaluates to a string.
If the value of the key in the hash table was a *promise*, a procedure will be returned that, when called, will call that promise.
If the value of the key is a string, a procedure will be returned that, when called, returns that string."
(when (and (not (string? key))
(not (procedure? key)))
(bad-key-type "reference" (list key)))
@ -427,15 +417,17 @@ that string."
(if (promise? val)
(lambda ()
(let ((VAL (force val)))
;; FIXME: put verbose print here?
;; FIXME(spk121): put verbose print here?
VAL))
;; else
(lambda ()
val)))))))
;; FIXME-DOCS(Krey)
(define-syntax $$
(lambda (stx)
(syntax-case stx ()
((_ key)
#'(reference-func (symbol->string (syntax->datum #'key)))))))
;; makevards.scm ends here

@ -34,8 +34,13 @@
string-next-token
string-remove-comments
string-starts-with?
string-shrink-whitespace
))
string-shrink-whitespace))
;;; Commentary:
;;;
;;; DOCS
;;;
;;; Code:
(define (read-line-handle-escaped-newline)
"Reads a line of text from the current input port.
@ -82,8 +87,7 @@ squash-whitespace? is #t."
(string-rindex str #\newline 0 backslash-index)))
(else
;; We cut the number of backslashes in half, remove a backslash
;; and newline, maybe squash any following whitespace.
;; We cut the number of backslashes in half, remove a backslash and newline, maybe squash any following whitespace.
(loop
(string-append
(substring str 0 backslash-index)
@ -95,9 +99,11 @@ squash-whitespace? is #t."
(substring str (1+ newline-index))))
(string-rindex str #\newline 0 backslash-index))))))))
;; FIXME-DOCS(Krey)
(define (string-count-backslashes-at-end str)
(string-count-matching-chars-at-end str #\\))
;; FIXME-DOCS(Krey)
(define (string-count-matching-chars-at-end str c)
(if (not (string? str))
0
@ -117,9 +123,7 @@ squash-whitespace? is #t."
n))))))
(define* (string-find-char-unquote str #:optional (stop1 #f) (stop2 #f) #:key (blank #f) (ignorevars #f))
"Search string for an unquoted stopchar. Search until the end of
line is reached or until the blank char is reached. A backslash
quotes the stopchars and the blank.
"Search string for an unquoted stopchar. Search until the end of line is reached or until the blank char is reached. A backslash quotes the stopchars and the blank.
The stopchars and blank may be #f, to ignore them in this call.
@ -181,8 +185,7 @@ Returns two values
(string-drop str (- i (quotient j 2)))))
(set! i (- i (quotient j 2)))
(when (even? j)
;; All the backslashes quoted each other; the stopchar
;; was unquoted
;; All the backslashes quoted each other; the stopchar was unquoted
(set! ret #t)
(break))
(set! str str2))
@ -197,10 +200,7 @@ Returns two values
(values #f #f))))
(define (string-find-preceding-backslashes str i)
"Given I, a position in a string, this returns a position,
of first of a range sequential backslashes that immediately precedes
that position in the string. If no backslashes precede that position,
I is returned."
"Given I, a position in a string, this returns a position, of first of a range sequential backslashes that immediately precedes that position in the string. If no backslashes precede that position, I is returned."
(let loop ((j i))
(cond
((= j 0)
@ -211,10 +211,7 @@ I is returned."
j))))
(define (string-find-repeated-chars str c)
"Given a character c, this finds the position of of first instance
of the character in the string. If the character repeats, it returns,
as a pair, the position of the character, and the position after the
run of characters. If the character is not present, it returns #f"
"Given a character c, this finds the position of of first instance of the character in the string. If the character repeats, it returns, as a pair, the position of the character, and the position after the run of characters. If the character is not present, it returns #f"
(let ((i (string-index str c)))
(if (not i)
#f
@ -230,9 +227,7 @@ run of characters. If the character is not present, it returns #f"
(cons i j))))))))
(define (string-next-token str i)
"Given a position i, this returns the position of the first
non-whitespace character after i. If the end of line is reached,
it returns the length of the string."
"Given a position i, this returns the position of the first non-whitespace character after i. If the end of line is reached, it returns the length of the string."
(or
(string-index str
(lambda (c)
@ -248,9 +243,7 @@ it returns the length of the string."
(string-copy str))))
(define (string-shrink-whitespace str start)
"Given a string, and a location in a string, this returns a new copy
of string where all the whitespace beginning at location i is replaced
by a single space"
"Given a string, and a location in a string, this returns a new copy of string where all the whitespace beginning at location i is replaced by a single space"
(let ((len (string-length str)))
(if (or (>= start len)
(not (char-set-contains? char-set:blank (string-ref str start))))
@ -268,3 +261,5 @@ by a single space"
(define (string-starts-with? str c)
(char=? (string-ref str 0) c))
;;; parse-libs.scm ends here

@ -25,8 +25,13 @@
#:use-module (potato parse-lib)
#:export (parse _readline))
;; A makefile can contain rules, macro definitions, include lines,
;; and comments.
;;; Commentary:
;;;
;;; DOCS
;;;
;;; Code:
;; A makefile can contain rules, macro definitions, include lines, and comments.
(define (parse filename)
(with-input-from-file filename _eval #:guess-encoding #t))