(zilch planner): drop
Turns out this idea was kind of a dead end. Change-Id: Id90b2249191ad66b0691471aa1721d726a6a6964
This commit is contained in:
parent
edbdf48a5a
commit
933b942a62
8 changed files with 1 additions and 250 deletions
|
|
@ -21,8 +21,6 @@
|
|||
trace
|
||||
json
|
||||
|
||||
(callPackage ../planner {})
|
||||
|
||||
libsodium # TODO(puck): don't propagate this
|
||||
];
|
||||
}
|
||||
|
|
|
|||
|
|
@ -13,7 +13,6 @@
|
|||
(zilch lib hash) (zilch lib rewrite)
|
||||
(zilch nix daemon) (zilch nix drv) (zilch nix path)
|
||||
(zilch nix hash)
|
||||
(zilch planner step)
|
||||
(zilch zexpr)
|
||||
(srfi 18) (srfi 128) (srfi 132) (srfi 146) (srfi 152) (srfi 207)
|
||||
(chicken base) (chicken format) socket)
|
||||
|
|
@ -615,25 +614,6 @@
|
|||
(set-derivation-meta! (store-path-drv path) (cons (cons 'post-build callback) (or (derivation-meta (store-path-drv path)) '())))
|
||||
path)
|
||||
|
||||
(register-build-step '((zilch core magic) build) #t
|
||||
(lambda items
|
||||
(printf "received build info: ~S\n" items)
|
||||
(define all-paths '())
|
||||
(for-each
|
||||
(lambda (item)
|
||||
(define outputs (list-ref item 1))
|
||||
(define drv-path (list-ref item 2))
|
||||
(set! all-paths (append (map (lambda (o) (string-append drv-path "!" o)) outputs) all-paths)))
|
||||
items)
|
||||
(daemon-wop-build-paths (*daemon*) (list->vector all-paths))
|
||||
(define output '())
|
||||
(for-each
|
||||
(lambda (item)
|
||||
(define output-map (daemon-wop-query-derivation-output-map (*daemon*) (list-ref item 2)))
|
||||
(set! output (cons (cons (car item) output-map) output)))
|
||||
items)
|
||||
output))
|
||||
|
||||
;; Ensures the `<store-path>` exists, then opens an input port to allow reading from it.
|
||||
(define (store-path-open path)
|
||||
(increment-counter 2)
|
||||
|
|
|
|||
|
|
@ -12,6 +12,5 @@
|
|||
srfi-152
|
||||
srfi-207
|
||||
(callPackage ../../core {})
|
||||
(callPackage ../../planner {})
|
||||
];
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
((version "0.0.1")
|
||||
(synopsis "Nix. Noppes. Nada.")
|
||||
(author "puck")
|
||||
(dependencies r7rs json zilch zilch.planner srfi-132 srfi-152 srfi-207)
|
||||
(dependencies r7rs json zilch srfi-132 srfi-152 srfi-207)
|
||||
(component-options
|
||||
(csc-options "-X" "r7rs" "-X" "zilch.zexpr" "-R" "r7rs" "-optimize-level" "3"))
|
||||
(components
|
||||
|
|
|
|||
|
|
@ -1,11 +0,0 @@
|
|||
{ chickenPackages, callPackage }:
|
||||
(callPackage ../lib/build-chicken-parallel {}) {
|
||||
name = "zilch-planner";
|
||||
src = ./.;
|
||||
|
||||
buildInputs = with chickenPackages.chickenEggs; [
|
||||
chickenPackages.chicken
|
||||
r7rs
|
||||
srfi-146
|
||||
];
|
||||
}
|
||||
|
|
@ -1,205 +0,0 @@
|
|||
(define-library (zilch planner step)
|
||||
(import
|
||||
(scheme base) (scheme write) (scheme process-context) (scheme lazy) (scheme case-lambda)
|
||||
(chicken format)
|
||||
(srfi 128) (srfi 146))
|
||||
|
||||
(export
|
||||
register-build-step
|
||||
|
||||
empty-build-plan build-plan-print build-plan-tick
|
||||
build-plan-next-id
|
||||
|
||||
build-plan-current-plan
|
||||
|
||||
build-plan-append build-plan-tail-call build-plan-return-append)
|
||||
|
||||
(begin
|
||||
(define-record-type <build-plan>
|
||||
(make-build-plan steps ready-to-run finalized last-id)
|
||||
build-plan?
|
||||
(steps build-plan-steps set-build-plan-steps!)
|
||||
(ready-to-run build-plan-ready-to-run set-build-plan-ready-to-run!)
|
||||
(finalized build-plan-finalized set-build-plan-finalized!)
|
||||
(last-id build-plan-last-id set-build-plan-last-id!))
|
||||
|
||||
;; Represents a single step in the build.
|
||||
;; id is a monotonically increasing identifier.
|
||||
;; dependencies is an alist of identifiers for other build steps to when they were added.
|
||||
(define-record-type <build-step>
|
||||
(make-build-step id dependencies type arguments called-from)
|
||||
build-step?
|
||||
(id build-step-id)
|
||||
(dependencies build-step-dependencies set-build-step-dependencies!)
|
||||
(type build-step-type)
|
||||
(arguments build-step-arguments set-build-step-arguments!)
|
||||
(called-from build-step-called-from))
|
||||
|
||||
(define-record-type <build-step-type>
|
||||
(make-build-step-type proc name batch)
|
||||
build-step-type?
|
||||
(proc build-step-type-proc)
|
||||
(name build-step-type-name)
|
||||
(batch build-step-type-batch))
|
||||
|
||||
;; Returns a new empty build plan.
|
||||
(define (empty-build-plan)
|
||||
(make-build-plan (mapping (make-default-comparator)) '() (mapping (make-default-comparator)) 0))
|
||||
|
||||
;; Returns a monotonically-increasing identifier for this build plan.
|
||||
(define (build-plan-next-id plan)
|
||||
(define id (+ (build-plan-last-id plan) 1))
|
||||
(set-build-plan-last-id! plan id)
|
||||
id)
|
||||
|
||||
;; Appends a new step to the build plan, returning its ID.
|
||||
(define (build-plan-append plan type args dependencies)
|
||||
(define id (build-plan-next-id plan))
|
||||
(define new-step (make-build-step id dependencies type args #f))
|
||||
(set-build-plan-steps! plan (mapping-set! (build-plan-steps plan) id new-step))
|
||||
id)
|
||||
|
||||
(define known-build-types (mapping (make-default-comparator)))
|
||||
|
||||
;; Register a build step type.
|
||||
;; A build step type's procedure is called (proc args . dependency-outputs),
|
||||
;; and returns a single value, which is the result.
|
||||
;; A batch build step is called as (proc (id args . dependency-outputs) (id args . dependency-outputs) ....)
|
||||
;; and returns an alist of (id . result).
|
||||
(define (register-build-step name is-batch proc)
|
||||
(set! known-build-types
|
||||
(mapping-set! known-build-types name
|
||||
(make-build-step-type proc name is-batch))))
|
||||
|
||||
(define (build-plan-print plan)
|
||||
(printf "build plan! ~S steps to go, of which ~S ready to run (~S finalized)\n"
|
||||
(mapping-size (build-plan-steps plan))
|
||||
(length (build-plan-ready-to-run plan))
|
||||
(mapping-size (build-plan-finalized plan)))
|
||||
|
||||
(mapping-for-each
|
||||
(lambda (step-id step)
|
||||
(define ready-to-run (member step (build-plan-ready-to-run plan)))
|
||||
(printf "- step ~S: ~S (ready to run? ~S)\n" step-id (build-step-type step) (not (eq? ready-to-run #f)))
|
||||
(printf " arguments: \n")
|
||||
(for-each (lambda (arg) (printf " - ~S\n" arg)) (build-step-arguments step))
|
||||
(printf " dependencies: ~S\n\n" (build-step-dependencies step)))
|
||||
(build-plan-steps plan))
|
||||
(mapping-for-each
|
||||
(lambda (step-id res)
|
||||
(printf "- result ~S: ~S\n" step-id res))
|
||||
(build-plan-finalized plan))
|
||||
(printf "\n"))
|
||||
|
||||
(define build-plan-current-plan-inner (make-parameter #f))
|
||||
(define build-plan-early-exit (make-parameter #f))
|
||||
|
||||
;; Returns a handle to the current build plan, if inside a build step.
|
||||
(define (build-plan-current-plan)
|
||||
(define plan (build-plan-current-plan-inner))
|
||||
(unless plan (error "cannot fetch current plan outside build plan context"))
|
||||
plan)
|
||||
|
||||
;; Tail call into a different build plan step. Arguments are similar to (build-plan-append).
|
||||
(define (build-plan-tail-call type args dependencies)
|
||||
(unless (build-plan-early-exit)
|
||||
(error "cannot build-plan-tail-call outside build plan context"))
|
||||
((build-plan-early-exit) (list 'tail-call type args dependencies)))
|
||||
|
||||
;; Stops executing this build plan step, and appends dependencies.
|
||||
;; If a second argument is given, the arguments to the current build step
|
||||
;; are replaced wholesale.
|
||||
(define build-plan-return-append
|
||||
(case-lambda
|
||||
((extra-dependencies new-args)
|
||||
(unless (build-plan-early-exit)
|
||||
(error "cannot build-plan-return-append outside build plan context"))
|
||||
((build-plan-early-exit) (list 'append extra-dependencies new-args)))
|
||||
((extra-dependencies) (build-plan-return-append extra-dependencies #f))))
|
||||
|
||||
;; Run all ready-to-run build steps, and mark any build steps newly runnable as such.
|
||||
(define (build-plan-tick plan)
|
||||
(define (collect-build-step-args step)
|
||||
(append (build-step-arguments step) (map (lambda (v) (mapping-ref (build-plan-finalized plan) v)) (build-step-dependencies step))))
|
||||
|
||||
;; Register the result of the build step and remove it from the list of pending steps.
|
||||
(define (handle-build-step-result step-id result)
|
||||
(set-build-plan-finalized! plan (mapping-set! (build-plan-finalized plan) step-id result))
|
||||
(set-build-plan-steps! plan (mapping-delete! (build-plan-steps plan) step-id)))
|
||||
|
||||
;; Collect all steps we can run now.
|
||||
;; These are grouped by build step type, for batching reasons.
|
||||
(define ready-to-run (build-plan-ready-to-run plan))
|
||||
(set-build-plan-ready-to-run! plan '())
|
||||
(define run-groupings (mapping (make-default-comparator)))
|
||||
|
||||
;; Collect the type of steps we can run right now.
|
||||
(for-each
|
||||
(lambda (step)
|
||||
(set! run-groupings
|
||||
(mapping-update!/default
|
||||
run-groupings
|
||||
(build-step-type step)
|
||||
(lambda (prev) (cons step prev))
|
||||
'())))
|
||||
ready-to-run)
|
||||
|
||||
(define (run-build-step step-type step)
|
||||
(define result
|
||||
(call-with-current-continuation
|
||||
(lambda (cc)
|
||||
(list 'result (parameterize ((build-plan-early-exit cc) (build-plan-current-plan-inner plan)) (apply (build-step-type-proc step-type) (collect-build-step-args step)))))))
|
||||
(case (car result)
|
||||
((result) (handle-build-step-result (build-step-id step) (list-ref result 1)))
|
||||
((tail-call)
|
||||
(set-build-plan-steps! plan
|
||||
(mapping-set! (build-plan-steps plan)
|
||||
(build-step-id step)
|
||||
(make-build-step (build-step-id step)
|
||||
(list-ref result 3)
|
||||
(list-ref result 1)
|
||||
(list-ref result 2)
|
||||
(cons (build-plan-next-id plan) step)))))
|
||||
((append)
|
||||
(set-build-plan-steps! plan
|
||||
(mapping-set! (build-plan-steps plan)
|
||||
(build-step-id step)
|
||||
(make-build-step (build-step-id step)
|
||||
(append (build-step-dependencies step) (list-ref result 1))
|
||||
(build-step-type step)
|
||||
(or (list-ref result 2) (build-step-arguments step))
|
||||
(cons (build-plan-next-id plan) step)))))))
|
||||
|
||||
;; Run all build steps that are ready to run.
|
||||
(mapping-for-each
|
||||
(lambda (step-type-name steps)
|
||||
(define step-type (mapping-ref known-build-types step-type-name))
|
||||
(cond
|
||||
((build-step-type-batch step-type)
|
||||
(parameterize
|
||||
((build-plan-early-exit (lambda args (error "cannot early-exit from batch build step")))
|
||||
(build-plan-current-plan-inner plan))
|
||||
(for-each
|
||||
(lambda (result) (apply handle-build-step-result result))
|
||||
(apply (build-step-type-proc step-type) (map (lambda (a) (cons (build-step-id a) (collect-build-step-args a))) steps)))))
|
||||
(else
|
||||
(for-each
|
||||
(lambda (step) (run-build-step step-type step))
|
||||
steps))))
|
||||
run-groupings)
|
||||
|
||||
;; Mark any build step that is ready to run as such.
|
||||
(mapping-for-each
|
||||
(lambda (step-id step)
|
||||
(define finalized (do ((args (build-step-dependencies step) (cdr args))) ((or (null? args) (not (mapping-contains? (build-plan-finalized plan) (car args)))) (null? args))))
|
||||
(when finalized
|
||||
(set-build-plan-ready-to-run! plan (cons step (build-plan-ready-to-run plan)))))
|
||||
(build-plan-steps plan))
|
||||
|
||||
(cond
|
||||
((mapping-empty? (build-plan-steps plan))
|
||||
#t)
|
||||
((and (null? ready-to-run) (null? (build-plan-ready-to-run plan)))
|
||||
(error "deadlock"))
|
||||
(else #f)))))
|
||||
|
||||
|
|
@ -1,9 +0,0 @@
|
|||
((version "0.0.1")
|
||||
(synopsis "Nix. Noppes. Nada.")
|
||||
(author "puck")
|
||||
(dependencies r7rs srfi-128 srfi-146)
|
||||
(component-options
|
||||
(csc-options "-X" "r7rs" "-R" "r7rs" "-optimize-level" "3"))
|
||||
(components
|
||||
(extension zilch.planner.step
|
||||
(source "src/step.sld"))))
|
||||
|
|
@ -8,7 +8,6 @@ pkgs.mkShell {
|
|||
|
||||
buildInputs = [
|
||||
(pkgs.callPackage ./core {})
|
||||
(pkgs.callPackage ./planner {})
|
||||
(pkgs.callPackage ./lang/go {})
|
||||
(pkgs.callPackage ./lang/rust {})
|
||||
(pkgs.callPackage ./lang/ninja {})
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue