From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp10.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id gAIzDs82YmNc0QAAbAwnHQ (envelope-from ) for ; Wed, 02 Nov 2022 10:22:23 +0100 Received: from aspmx1.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp10.migadu.com with LMTPS id qFlaDc82YmNsMQAAG6o9tA (envelope-from ) for ; Wed, 02 Nov 2022 10:22:23 +0100 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id E977F255F3 for ; Wed, 2 Nov 2022 10:22:22 +0100 (CET) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oq9wq-0006qS-70; Wed, 02 Nov 2022 05:22:12 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oq9wh-0006oO-42 for help-guix@gnu.org; Wed, 02 Nov 2022 05:22:03 -0400 Received: from mx0.riseup.net ([198.252.153.6]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oq9wa-0005fc-Ru for help-guix@gnu.org; Wed, 02 Nov 2022 05:22:01 -0400 Received: from fews1.riseup.net (fews1-pn.riseup.net [10.0.1.83]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (2048 bits) server-digest SHA256 client-signature RSA-PSS (2048 bits) client-digest SHA256) (Client CN "mail.riseup.net", Issuer "R3" (not verified)) by mx0.riseup.net (Postfix) with ESMTPS id 4N2LxZ5LgDz9t74; Wed, 2 Nov 2022 09:21:54 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=riseup.net; s=squak; t=1667380914; bh=vHQZypBCoXvjEsTTnFZpY+vxPpukDF987Q6OzY98ogM=; h=References:From:To:Cc:Subject:Date:In-reply-to:From; b=qn/vXlhzvhl/12C0KHjDpA/exQSo0DPdgzxiRVAW1IlE8BaaLGd622oGBUfhmnRHA qC/6siI9kw30QWtylMn7bfCDC3F/ZezLwBkmfO1qGEyEqFmFQPsO2xVLyjPsAvGokT ISROd0rZmJkr4pQ48J034JnNY5oKA4yikOJrTmzg= X-Riseup-User-ID: 026467E3D3102DE003EBCE7E8BE104171539D2F69EDC9B06CAD5D5C998E929F9 Received: from [127.0.0.1] (localhost [127.0.0.1]) by fews1.riseup.net (Postfix) with ESMTPSA id 4N2LxY60phz5vXG; Wed, 2 Nov 2022 09:21:53 +0000 (UTC) References: <20221031204255.GB29692@dismail.de> <20221101171932.GB13253@dismail.de> From: Csepp To: jgart Cc: Julien Lepiller , help-guix@gnu.org Subject: Re: committer.scm Date: Wed, 02 Nov 2022 10:19:32 +0100 In-reply-to: <20221101171932.GB13253@dismail.de> Message-ID: <874jvhiudt.fsf@riseup.net> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Received-SPF: pass client-ip=198.252.153.6; envelope-from=raingloom@riseup.net; helo=mx0.riseup.net X-Spam_score_int: -23 X-Spam_score: -2.4 X-Spam_bar: -- X-Spam_report: (-2.4 / 5.0 requ) BAYES_00=-1.9, DKIM_INVALID=0.1, DKIM_SIGNED=0.1, RCVD_IN_DNSWL_LOW=-0.7, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: help-guix@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: "Help-Guix" Errors-To: help-guix-bounces+larch=yhetil.org@gnu.org X-Migadu-Flow: FLOW_IN X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1667380943; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=H/XyeeqlR1T8i6LT0UNaixPBZVwSPgqcvwxJw3ARNog=; b=KaeW7iuV3ub1d5xPtO5LGzOSEbahhmlbc5hyR5lmRnn/xDvF83jX5rug3KAJjdhzzCUZke meLyUZdV/9LneXSME1Z1MFfzNeFq3FzwFZtQK1ROdP+vmBd+LcTcwWIiaBQJCph7511HfX tFjK2OLvR8VXJWM907Uevy83RVq5bjWPSyKsBb1MmUP2YxWPDDZ5WW2D6uYLRXULYRAAp/ nmAGzZrXazEkbnsrjL9pD8oN8pDNDxrAhEp6hbv7wJ5hFOdqQjjiZYLRm8F/tGdxwQaPoo 94ROOyv33PUdjXiGptqDmU5tkOiedZK8N947EOA+rbEEMCsj4tOUbR0fFpaPyw== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1667380943; a=rsa-sha256; cv=none; b=SF10HmPrjmxb7aelg2305Bx4u/URjGelotGkD17jc3tZx++wWbaHpeoWRsBEdmyfgu5hzP hUWQW9J1lFC9M3sPGcJV/XXPmAGUUjvCeTl46pND2py0HJ3IN2AQzH/pV6YyJLbIM7TaR6 09MG4wrYfLaUdiHIJdrnWqzXzwYYEbmxoCuaKJBCjRXRBW5LNk0j5J+zpjzMjd2yU8JUNb hMLSAJ6mixIFeYzsxUDUd6JtCam1f2Wic+oGhvKlD4btqhskqH1lzoMPQagLdByHy01f7f BONiTzQ00gkokSkHpLXuyMYqBYhRFDmvhoWvIocS/b4lgQbxPXJ+RojzIyO4aw== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=pass header.d=riseup.net header.s=squak header.b="qn/vXlhz"; dmarc=pass (policy=none) header.from=riseup.net; spf=pass (aspmx1.migadu.com: domain of "help-guix-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="help-guix-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: -4.08 Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=riseup.net header.s=squak header.b="qn/vXlhz"; dmarc=pass (policy=none) header.from=riseup.net; spf=pass (aspmx1.migadu.com: domain of "help-guix-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="help-guix-bounces+larch=yhetil.org@gnu.org" X-Migadu-Queue-Id: E977F255F3 X-Spam-Score: -4.08 X-Migadu-Scanner: scn1.migadu.com X-TUID: a5tnC97uno4q --=-=-= Content-Type: text/plain jgart writes: > On Tue, 01 Nov 2022 07:57:28 +0100 Julien Lepiller wrote: >> Try calling it with pre-inst-env. > > Ohhh, yes that was it. I stopped calling it with pre-inst-env for some reason ;() > > THNX > > Now I just need to see how I am going to sort these 150+ crates in an automated fashion... If you have some graph theory and Guix know-how you might be able to get my commit sorter script working. Currently it's broken, as in it does not sort commits in the way they should be sorted, but it has a lot of useful bits already. --=-=-= Content-Type: text/plain Content-Disposition: inline; filename=sort-commit.scm Content-Description: commit sorter guile script (use-modules (gnu installer utils) (graph topological-sort) (guix build utils) (ice-9 exceptions) (ice-9 hash-table) (ice-9 match) (ice-9 popen) (ice-9 rdelim) (oop goops) (srfi srfi-1) (srfi srfi-13) (srfi srfi-2) (srfi srfi-26) (gnu packages) (guix packages)) (with-exception-handler exception-irritants (lambda () (package-propagated-inputs (module-ref (reload-module (resolve-module '(gnu packages ocaml-mirage) #:ensure #f)) 'ocaml-ppx-cstruct))) #:unwind? #t #:unwind-for-type &undefined-variable) (define from-commit "raingloom/mirageos-rebase") (define to-commit "after-dune") ;; The set (sorted list) of variables (symbols) we care about. (define variables-of-interest ;; starts out as #f to catch errors (make-parameter #f)) (define variable->commit-mapping (make-parameter #f)) (define dependency-digraph (make-parameter #f)) (define commit->log-index (make-parameter #f)) (define (with-input-from-make thunk) (lambda _ (with-input-from-port (open-pipe* OPEN_READ "make") thunk))) (define (set-current-commit! commit) (invoke "git" "checkout" commit)) (define (missing-variable-on-line line) (and-let* ((words (string-split line #\space)) (prefixed-var (find-tail (cut string=? "variable" <>) words)) ;; so cadr doesn't error (prefixed-var-ok? (equal? 2 (length prefixed-var))) (var-quoted (cadr prefixed-var)) (var-quoted-ok? (and (string-suffix? "'" var-quoted) (string-prefix? "`" var-quoted))) (var (string-drop-right (string-drop var-quoted 1) 1))) var)) (define (with-input-from-command thunk command) ;; TODO this is ugly, but run-external-command-with-handler does not return ;; the value that the handler returns, only the command's exit status (define ret #f) (define (handler port) (set! ret (with-input-from-port port thunk))) (run-external-command-with-handler handler command) ret) (define (current-commit-missing-definitions) (define (go) (let ((line (read-line))) (if (eof-object? line) '() (let ((variable (missing-variable-on-line line))) (if variable (cons variable (go)) (go)))))) (map string->symbol (with-input-from-command go '("make")))) (define (name->commit name) (define (go) (define hash (read-line)) (unless (eof-object? (read-line)) (error "unexpected additional output")) hash) (with-input-from-command go `("git" "show" "--format=%H" "--quiet" ,name))) (define (current-commit) (name->commit "HEAD")) (define (commits-since commit-name) (define commit (name->commit commit-name)) (define (go) (let ((line (read-line))) (cond ((eof-object? line) (error "ancestor commit does not exist")) ((string=? line commit) '()) (else (cons line (go)))))) (reverse (with-input-from-command go '("git" "log" "--format=%H")))) (define (files-changed commit) (cdr (with-input-from-command read-lines `("git" "show" "--oneline" "--name-only" ,commit)))) (define (module-file? file) (string-suffix? ".scm" file)) (define (path->module path) "Assumes PATH is a valid Scheme file." (let* ((components-rev (reverse (string-split path #\/))) (base (car components-rev)) (last-component (string-drop-right base (string-length ".scm")))) (map string->symbol (reverse (cons last-component (cdr components-rev)))))) (define (modules-changed commit) (map path->module (filter module-file? (files-changed commit)))) (define (touch-changed-files! commit) (apply invoke (cons "touch" (files-changed commit)))) (define (commits+missing-definitions commits) (map (lambda (commit) (set-current-commit! commit) (touch-changed-files! commit) (cons commit (current-commit-missing-definitions))) commits)) (define (set-insert set x) "Insert element X into the sorted list SET." (match set (() (list x)) ((a) (if (< a x) (list a x) (list x a))) ((a b . rest) (cond ((and (< a x) (< x b)) (cons* a x b rest)) ((equal? a x) set) ((< x a) (cons* x a (cdr set))) (else (cons a (set-insert (cdr set) x))))))) (define (add-dependent! dependency-graph commit dependent) (assoc-set! dependency-graph commit (set-insert dependent (or (assoc-ref dependency-graph commit) '())))) (define (deduplicate lst) (define ret '()) (for-each (lambda (x) (set! ret (assoc-set! ret x #t))) lst) (map car ret)) (define (current-commit-defined-vars-of-interest) (let ((vars-of-interest (variables-of-interest))) (deduplicate (concatenate (filter identity (map (lambda (module-name) (let ((module (reload-module (resolve-module module-name)))) (map (lambda (var) (and (module-variable module var) var)) vars-of-interest))) (modules-changed (current-commit)))))))) ;; : alist symbol (list string) (define (compute-variable->commit-mapping! commits) (fold (lambda (commit vars->commits) (set-current-commit! commit) (fold (lambda (var vars->commits) (assoc-set! vars->commits var (cons commit (or (assoc-ref vars->commits var) '())))) vars->commits (current-commit-defined-vars-of-interest))) '() commits)) (define (order-in-topology commit) (hash-ref (topology-vector) commit)) (define (order-in-log commit) (hash-ref (commit->log-index) commit)) (define (depends? commit dependency) "Does COMMIT depend on DEPENDENCY?" (sorted? (map order-in-topology (list commit dependency)) <)) (define (predates? a b) "Does commit A come before commit B in the original history?" (sorted? (map order-in-log (list a b)) <)) (define (commits-ordered? a b) "Commit A should come before B iff B has a direct dependency on A or if it comes before B in the git history, in that order of precedence." (or (depends? a b) (predates? a b))) (define (list->index-lookup-hash-table lst) (define mapping (make-hash-table)) (fold (lambda (x i) (hash-set! mapping x i) (+ 1 i)) 0 lst) mapping) (define (hash->alist hsh) (hash-fold acons '() hsh)) (set-current-commit! from-commit) ;; edges go from commits to variables (define commits (commits-since to-commit)) (commit->log-index (list->index-lookup-hash-table commits)) (define commits->missing-definitions (commits+missing-definitions commits)) (variables-of-interest (deduplicate (apply append (map cdr commits->missing-definitions)))) (define var->comm (compute-variable->commit-mapping! commits)) (variable->commit-mapping (alist->hash-table var->comm)) (define graph-n (length commits)) (define graph (make-bitvector (expt graph-n 2))) (define (coord->offset row col) (+ col (* graph-n row))) (define (connected? a b) (bitvector-bit-set? graph (coord->offset a b))) (define (connect! a b) (bitvector-set-bit! graph (coord->offset a b))) (let ((variable->commit-mapping (variable->commit-mapping))) (for-each (match-lambda ((commit . vars) (let ((commit-log-id (order-in-log commit))) (for-each (lambda (var) (let* ((dependencies (hash-ref variable->commit-mapping var))) (for-each (lambda (dependency) (connect! commit-log-id (order-in-log dependency)))))) vars)))) commits->missing-definitions)) --=-=-=--