diff --git a/core/default.nix b/core/default.nix index 3a7e46f..2e25081 100644 --- a/core/default.nix +++ b/core/default.nix @@ -21,8 +21,6 @@ trace json - (callPackage ../planner {}) - libsodium # TODO(puck): don't propagate this ]; } diff --git a/core/src/magic.sld b/core/src/magic.sld index b8323a5..a96b234 100644 --- a/core/src/magic.sld +++ b/core/src/magic.sld @@ -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 `` exists, then opens an input port to allow reading from it. (define (store-path-open path) (increment-counter 2) diff --git a/lang/ninja/default.nix b/lang/ninja/default.nix index 7e7c7a5..fd4a15d 100644 --- a/lang/ninja/default.nix +++ b/lang/ninja/default.nix @@ -12,6 +12,5 @@ srfi-152 srfi-207 (callPackage ../../core {}) - (callPackage ../../planner {}) ]; } diff --git a/lang/ninja/zilch-lang-ninja.egg b/lang/ninja/zilch-lang-ninja.egg index dffac9f..efed9f0 100644 --- a/lang/ninja/zilch-lang-ninja.egg +++ b/lang/ninja/zilch-lang-ninja.egg @@ -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 diff --git a/planner/default.nix b/planner/default.nix deleted file mode 100644 index 64293e8..0000000 --- a/planner/default.nix +++ /dev/null @@ -1,11 +0,0 @@ -{ chickenPackages, callPackage }: -(callPackage ../lib/build-chicken-parallel {}) { - name = "zilch-planner"; - src = ./.; - - buildInputs = with chickenPackages.chickenEggs; [ - chickenPackages.chicken - r7rs - srfi-146 - ]; -} diff --git a/planner/src/step.sld b/planner/src/step.sld deleted file mode 100644 index 7d3a87e..0000000 --- a/planner/src/step.sld +++ /dev/null @@ -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 - (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 - (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 - (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))))) - diff --git a/planner/zilch-planner.egg b/planner/zilch-planner.egg deleted file mode 100644 index 6fe68c5..0000000 --- a/planner/zilch-planner.egg +++ /dev/null @@ -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")))) diff --git a/shell.nix b/shell.nix index 45c8d6a..b809acf 100644 --- a/shell.nix +++ b/shell.nix @@ -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 {})