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

stash

Browse Source
This commit is contained in:
Michael Gran 2021-02-13 23:42:16 -08:00
parent e401dc59ca
commit f75e5e8f4b
5 changed files with 124 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
CHEATSHEET.md
View File

@ -14,7 +14,7 @@ Add this at the top of your build script.
Add this at the bottom of your build script
(execute)
The rules go in between `initialize` and `build`
## MAKEVARS
@ -46,50 +46,59 @@ have filenames or phony names.
recipe-1
recipe-2
...)
`target-name` is a string which is either a filename to be created
or an phony name like "all" or "clean".
Recipe as a string to be evaluated by the system
(: "foo.o" '("foo.c")
"cc -c foo.o")
Recipe as a procedure
(: "clean-foo" '()
(lambda ()
(delete-file "foo.o")))
Recipe as a procedure that returns #f to indicate failure
(: "recent" '()
(lambda ()
(if condition
#t
#f))))
Recipe as a procedure returning a string to be evaluated by the system
Recipe as a procedure returning a string to be evaluated by the
system
(: "foo.o" '("foo.c")
(lambda ()
(format #f "cc ~A -c foo.c" some-flags))
Recipe using recipe helper procedures, which create a string to be
evaluated by the system
Recipe using recipe helper procedures, which create a string to
be evaluated by the system
(: "foo.c" '("foo.c")
(~ ($ CC) ($ CFLAGS) "-c" $<))
Recipe as a boolean to indicate pass or failure without doing any
processing. For example, the rule below tells Potato Make that
the file "foo.c" exists without actually testing for it.
(: "foo.c" '() #t)
The *suffix rule* is a generic rule to convert one source file to
a target file, based on the filename extensions.
(-> ".c" ".o"
(~ ($ CC) ($ CFLAGS) "-c" $< "-o" $@))
## Recipe Helpers
Concatenate elements with `~`. `~` inserts spaces between the elements.
Concatenate elements with `~`. `~` inserts spaces between the
elements.
Elements can be
- strings
- procedures that return strings
@ -97,11 +106,11 @@ a target file, based on the filename extensions.
- automatic variables
- anything whose string representation as created by
(format #f "~A" ...) make sense
Any procedures are applied lazily, when the rule is executed.
(~ "string" (lambda () "string") ($ KEY) $@ 100 )
Three versions of `~` with special effects
(~- ...) ignores any errors
(~@ ...) doesn't print recipe to console
@ -110,7 +119,7 @@ a target file, based on the filename extensions.
## Automatic Variables
Recipes can contain the following automatic variables
$@ the target
$* the target w/o a filename suffix
$< the first prerequisite

26
potato/make.scm
View File

@ -19,8 +19,8 @@
suffix-rule ->
target-name $@
target-basename $*
newer-prerequisites $?
prerequisites $^
newer-prerequisites $? $$?
prerequisites $^ $$^
primary-prerequisite $<
string-compose ~
silent-compose ~@
@ -189,6 +189,8 @@ arguments."
(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)
@ -263,28 +265,32 @@ targets listed on the parsed command-line are used."
(when (null? targets)
(set! targets %targets))
(when (null? targets)
(debug "No target was specified.~%")
(debug "No build target was explicitely specified.~%")
(let ((rule (first-target-rule-name)))
(if rule
(begin
(debug "Using first rule ~A as target.~%" rule)
(set! targets (list rule))
;; else
(debug "There are no target rules in the recipe.~%")))))
(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)))
(print "Attempting to run target “~A”.~%" target)
(when (>= %verbosity 3)
(format #t "Considering target file ~A~A~A.~%" (lquo) target (rquo)))
(if (not (build target))
(begin
(print "The recipe for “~A” has failed.~%" target))
(print "The recipe for “~A” has failed.~%" target)
#f)
;; else
(begin
(print "The recipe for “~A” has succeeded.~%" target)
(if (not (null? rest))
(loop (car rest) (cdr rest))))))))
(loop (car rest) (cdr rest))
;; True if all targets are built successfully.
#t))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

4
potato/makevars.scm
View File

@ -25,7 +25,7 @@
;; If the '-e' flag is set level 1 doesn't override level 3 and 4.
(define %ascii? #f)
(define %makevars #f)
(define %makevars (make-hash-table))
(define %elevate-environment? #f)
(define %strict #f)
(define %verbose? #t)
@ -190,7 +190,7 @@ the value of MAKEFLAGS or SHELL."
verbosity
ascii?)
(set! %elevate-environment? elevate-environment?)
(set! %makevars (make-hash-table))
(hash-clear! %makevars)
(set! %strict strict?)
(set! %verbose? (= verbosity 3))
(set! %ascii? ascii?)

131
potato/rules.scm
View File

@ -17,10 +17,10 @@
target-rule :
suffix-rule ->
target-name $@
newer-prerequisites $?
newer-prerequisites $? $$?
primary-prerequisite $<
target-basename $*
prerequisites $^
prerequisites $^ $$^
build
string-compose ~
silent-compose ~@
@ -215,13 +215,11 @@ it is evaluated."
(cond
((pair? recipe)
recipe)
((string? recipe)
(cons 'default recipe))
(else
(error "bad recipe for target rule"))))
(cons 'default recipe))))
recipes)))
(let ((rule (make-suffix-rule source target recipes 1)))
(let ((rule (make-suffix-rule source target recipes2 1)))
(set! %suffix-rules (cons rule %suffix-rules)))))
;; Alias
@ -346,15 +344,19 @@ it is evaluated."
- it has an mtime
- all its children have mtimes
- its mtime is older than the mtime of its children"
(let ((children (map node-get-mtime (node-get-children node)))
(parent (node-get-mtime node)))
(if (every (lambda (child)
(and (integer? parent)
(integer? child)
(>= parent child)))
children)
#t
#f)))
(let ((children (node-get-children node))
(parent-mtime (node-get-mtime node)))
(if (or (null? children) (not (integer? parent-mtime)))
;; Targets without children are always rebuilt.
;; Targets without mtimes are always rebuilt.
#f
(let ((children-mtime (map node-get-mtime children)))
(if (every (lambda (child-mtime)
(and (integer? child-mtime)
(>= parent-mtime child-mtime)))
children-mtime)
#t
#f)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; AUTOMATIC VARIABLES
@ -365,19 +367,30 @@ it is evaluated."
(define primary-prerequisite 'unspecified)
(define newer-prerequisites '())
(define (string-append-with-spaces lst)
"Appends the strings in lst, adding spaces in between."
(if (null? lst)
""
;; else
(fold
(lambda (elem prev)
(string-append prev " " elem))
(car lst)
(cdr lst))))
(define $@ (lambda () target-name))
(define $* (lambda () target-basename))
(define $< (lambda () primary-prerequisite))
(define $$? (lambda () newer-prerequisites))
(define $? (lambda () (apply string-compose newer-prerequisites)))
(define $? (lambda () (string-append-with-spaces newer-prerequisites)))
(define $$^ (lambda () prerequisites))
(define $^ (lambda () (apply string-compose prerequisites)))
(define $^ (lambda () (string-append-with-spaces prerequisites)))
(define (target-rule-prep-automatic-variables node rule)
(set! target-name (node-get-name node))
(set! target-basename (basename target-name))
(set! prerequisites (target-rule-get-prerequisites rule))
(set! primary-prerequisite (if (null? prerequisites) #f (car prerequisites)))
(set! primary-prerequisite (if (null? prerequisites) "" (car prerequisites)))
(set! newer-prerequisites
;; If this node doesn't have a real file attached, then all
;; prerequistes are "newer".
@ -596,7 +609,7 @@ failure condition happens, mark the node as having failed."
;; - Ignore errors
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LET'S GO!
;; LET'S GO!
(define (initialize-rules targets builtins? ignore-errors? continue-on-error? no-execution? verbosity ascii?)
(set! %target-rules '())
@ -616,7 +629,7 @@ failure condition happens, mark the node as having failed."
(node-set-children! node '())
;; FIXME: here check that this name differs from all ancenstor's
;; names
;; Try to the file's modification time.
(when (file-exists? name)
(when (not (regular-file? name))
@ -624,12 +637,12 @@ failure condition happens, mark the node as having failed."
(when (not (access? name R_OK))
(no-read-access-to-file "create-node" name))
(node-set-mtime! node (compute-mtime name)))
;; Search for matching target rule.
(when (not (null? %target-rules))
(let loop ((rule (car %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))
@ -639,7 +652,7 @@ failure condition happens, mark the node as having failed."
(node-set-logic! node 'and)
;; For target-rules, the prerequisites comes from the
;; rule itself.
;; Oooh, recursion!
(node-set-children! node
(map (lambda (prereq)
@ -651,52 +664,49 @@ failure condition happens, mark the node as having failed."
;; 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 (or
;; string suffix
(and (string? targ)
(string-suffix? targ name))
;; procedure suffix
(and (procedure? targ)
(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-logic! node 'or)
(let* ((src (suffix-rule-get-source rule))
(prereq
(if (string? src)
(string-append
(string-drop-right name (string-length src))
src)
;; else, src is a conversion func.
(src name))))
;; Note the recursion here.
(node-set-children! node
(cons (create-node prereq node)
(node-get-children node)))))))
%suffix-rules))
(for-each
(lambda (rule)
(let ((targ (suffix-rule-get-target rule)))
(format #t "possible suffix rule ~S~%" 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-logic! node 'or)
(let* ((src (suffix-rule-get-source rule))
(prereq
(string-append
(string-drop-right name (string-length src))
src)))
;; First matching rule has highest priority
;; 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?
(node-set-rules! node (reverse (node-get-rules node)))
(node-set-children! node (reverse (node-get-children node)))
|#
;;(format #t "matching suffix rules ~S~%" (node-get-rules node))
;;(format #t "matching children rules ~S~%" (node-get-children node))
;; And node is ready to go
node))
(define (build root)
"Give a tree of <node>, this executes the recipes therein."
(format #t "BLAMMO 1 ~S~%" root)
(let ((tree (create-node root #f)))
(let ((node tree))
(while #t
(when (>= %verbosity 2) (format #t "PRocessing ~S~%" (node-get-name node)))
(if (undetermined? node)
(begin
(when (>= %verbosity 3) (format #t "~S is undetermined~%" (node-get-name node)))
(if (children-complete? node)
(if (children-passed? node)
(if (up-to-date? node)
@ -712,12 +722,15 @@ failure condition happens, mark the node as having failed."
(set! node (get-next-child node))))
;; else, this node is determined
(begin
(if (and (not %ignore-errors?) (failed? node))
(break)
(when (>= %verbosity 2) (format #t "~S is determined ~S~%" (node-get-name node) (node-get-status node)))
#| (if (and (not %ignore-errors?) (failed? node))
(break)|#
;; else not failed
(if (has-parent? node)
(set! node (get-parent node))
;; else, there is no parent to this node
(break)))))))))
(break))
;; )
))))
;; Return the command output of the root node
(passed? tree)))

3
potato/text.scm
View File

@ -2,9 +2,12 @@
#:export (underline
default
right-arrow
left-arrow
ellipses
C0
red
lquo
rquo
initialize-text))
(define %fancy #t)