(zilch planner): drop

Turns out this idea was kind of a dead end.

Change-Id: Id90b2249191ad66b0691471aa1721d726a6a6964

core/default.nix

@@ -21,8 +21,6 @@
     trace
     json
 
-    (callPackage ../planner {})
-
     libsodium # TODO(puck): don't propagate this
   ];
 }

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 `<store-path>` exists, then opens an input port to allow reading from it.
    (define (store-path-open path)
      (increment-counter 2)

lang/ninja/default.nix

@@ -12,6 +12,5 @@
     srfi-152
     srfi-207
     (callPackage ../../core {})
-    (callPackage ../../planner {})
   ];
 }

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

planner/default.nix

@@ -1,11 +0,0 @@
-{ chickenPackages, callPackage }:
-(callPackage ../lib/build-chicken-parallel {}) {
-  name = "zilch-planner";
-  src = ./.;
-
-  buildInputs = with chickenPackages.chickenEggs; [
-    chickenPackages.chicken
-    r7rs
-    srfi-146
-  ];
-}

planner/src/step.sld

@@ -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)))))
-

planner/zilch-planner.egg

@@ -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"))))

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 {})