From 3c6b9fb5d2627c9f23b58ce530025a8dc8cc3c3c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 17 Jun 2019 15:54:17 +0200 Subject: gexp: Remove #:pre-load-modules? parameter. * guix/gexp.scm (gexp->derivation): Remove #:pre-load-modules?. (compiled-modules): Likewise. Inline the case correspoding to PRE-LOAD-MODULES? = #t. * guix/packages.scm (patch-and-repack): Remove #:pre-load-modules?. --- guix/gexp.scm | 68 +++++++++++++++++++++-------------------------------------- 1 file changed, 24 insertions(+), 44 deletions(-) (limited to 'guix/gexp.scm') diff --git a/guix/gexp.scm b/guix/gexp.scm index 4f2adba90a..9bf68a91f4 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -633,12 +633,6 @@ names and file names suitable for the #:allowed-references argument to leaked-env-vars local-build? (substitutable? #t) (properties '()) - - ;; TODO: This parameter is transitional; it's here - ;; to avoid a full rebuild. Remove it on the next - ;; rebuild cycle. - (pre-load-modules? #t) - deprecation-warnings (script-name (string-append name "-builder"))) "Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a @@ -743,8 +737,6 @@ The other arguments are as for 'derivation'." #:module-path module-path #:extensions extensions #:guile guile-for-build - #:pre-load-modules? - pre-load-modules? #:deprecation-warnings deprecation-warnings) (return #f))) @@ -1220,11 +1212,7 @@ last one is created from the given object." (guile (%guile-for-build)) (module-path %load-path) (extensions '()) - (deprecation-warnings #f) - - ;; TODO: This flag is here to prevent a full - ;; rebuild. Remove it on the next rebuild cycle. - (pre-load-modules? #t)) + (deprecation-warnings #f)) "Return a derivation that builds a tree containing the `.go' files corresponding to MODULES. All the MODULES are built in a context where they can refer to each other." @@ -1257,11 +1245,8 @@ they can refer to each other." (let* ((base (basename entry ".scm")) (output (string-append output "/" base ".go"))) (format #t "[~2@a/~2@a] Compiling '~a'...~%" - (+ 1 processed - (ungexp-splicing (if pre-load-modules? - (gexp ((ungexp total))) - (gexp ())))) - (ungexp (* total (if pre-load-modules? 2 1))) + (+ 1 processed (ungexp total)) + (ungexp (* total 2)) entry) (compile-file entry #:output-file output @@ -1275,6 +1260,26 @@ they can refer to each other." processed entries))) + (define* (load-from-directory directory + #:optional (loaded 0)) + "Load all the source files found in DIRECTORY." + ;; XXX: This works around . + (let ((entries (map (cut string-append directory "/" <>) + (scandir directory regular?)))) + (fold (lambda (file loaded) + (if (file-is-directory? file) + (load-from-directory file loaded) + (begin + (format #t "[~2@a/~2@a] Loading '~a'...~%" + (+ 1 loaded) (ungexp (* 2 total)) + file) + (save-module-excursion + (lambda () + (primitive-load file))) + (+ 1 loaded)))) + loaded + entries))) + (setvbuf (current-output-port) (cond-expand (guile-2.2 'line) (else _IOLBF))) @@ -1310,32 +1315,7 @@ they can refer to each other." (mkdir (ungexp output)) (chdir (ungexp modules)) - (ungexp-splicing - (if pre-load-modules? - (gexp ((define* (load-from-directory directory - #:optional (loaded 0)) - "Load all the source files found in DIRECTORY." - ;; XXX: This works around . - (let ((entries (map (cut string-append directory "/" <>) - (scandir directory regular?)))) - (fold (lambda (file loaded) - (if (file-is-directory? file) - (load-from-directory file loaded) - (begin - (format #t "[~2@a/~2@a] Loading '~a'...~%" - (+ 1 loaded) - (ungexp (* 2 total)) - file) - (save-module-excursion - (lambda () - (primitive-load file))) - (+ 1 loaded)))) - loaded - entries))) - - (load-from-directory "."))) - (gexp ()))) - + (load-from-directory ".") (process-directory "." (ungexp output) 0)))) ;; TODO: Pass MODULES as an environment variable. -- cgit v1.2.3 From 24ab804ce11fe12ff49cd144a3d9c4bfcf55b41c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 23 Sep 2019 22:17:39 +0200 Subject: gexp: Catch and report non-self-quoting gexp inputs. Previously we would, for example, generate build scripts in the store; when trying to run them, we'd get a 'read' error due to the presence of # syntax in there. * guix/gexp.scm (gexp->sexp)[self-quoting?]: New procedure. [reference->sexp]: Check whether the argument in a box is self-quoting. Raise a '&gexp-input-error' condition if it's not. * tests/gexp.scm ("lower-gexp, non-self-quoting input"): New test. --- guix/gexp.scm | 13 ++++++++++++- tests/gexp.scm | 7 +++++++ 2 files changed, 19 insertions(+), 1 deletion(-) (limited to 'guix/gexp.scm') diff --git a/guix/gexp.scm b/guix/gexp.scm index 45cd5869f7..0d0b661c65 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1005,6 +1005,15 @@ references; otherwise, return only non-native references." (target (%current-target-system))) "Return (monadically) the sexp corresponding to EXP for the given OUTPUT, and in the current monad setting (system type, etc.)" + (define (self-quoting? x) + (letrec-syntax ((one-of (syntax-rules () + ((_) #f) + ((_ pred rest ...) + (or (pred x) + (one-of rest ...)))))) + (one-of symbol? string? keyword? pair? null? array? + number? boolean?))) + (define* (reference->sexp ref #:optional native?) (with-monad %store-monad (match ref @@ -1034,8 +1043,10 @@ and in the current monad setting (system type, etc.)" #:target target))) ;; OBJ must be either a derivation or a store file name. (return (expand thing obj output))))) - (($ x) + (($ (? self-quoting? x)) (return x)) + (($ x) + (raise (condition (&gexp-input-error (input x))))) (x (return x))))) diff --git a/tests/gexp.scm b/tests/gexp.scm index 5c013d838d..50d0948659 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -871,6 +871,13 @@ (eq? (derivation-input-derivation (lowered-gexp-guile lexp)) (%guile-for-build))))))) +(test-eq "lower-gexp, non-self-quoting input" + + + (guard (c ((gexp-input-error? c) + (gexp-error-invalid-input c))) + (run-with-store %store + (lower-gexp #~(foo #$+))))) + (test-assertm "gexp->derivation #:references-graphs" (mlet* %store-monad ((one (text-file "one" (random-text))) -- cgit v1.2.3 From 7b7e5b88fc341ddeada4a8df418767ce4dfca691 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 23 Sep 2019 22:23:52 +0200 Subject: gexp: Remove unused procedure. * guix/gexp.scm (syntax-location-string): Remove. --- guix/gexp.scm | 13 ------------- 1 file changed, 13 deletions(-) (limited to 'guix/gexp.scm') diff --git a/guix/gexp.scm b/guix/gexp.scm index 0d0b661c65..e788fc5981 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1055,19 +1055,6 @@ and in the current monad setting (system type, etc.)" reference->sexp (gexp-references exp)))) (return (apply (gexp-proc exp) args)))) -(define (syntax-location-string s) - "Return a string representing the source code location of S." - (let ((props (syntax-source s))) - (if props - (let ((file (assoc-ref props 'filename)) - (line (and=> (assoc-ref props 'line) 1+)) - (column (assoc-ref props 'column))) - (if file - (simple-format #f "~a:~a:~a" - file line column) - (simple-format #f "~a:~a" line column))) - ""))) - (define-syntax-rule (define-syntax-parameter-once name proc) ;; Like 'define-syntax-parameter' but ensure the top-level binding for NAME ;; does not get redefined. This works around a race condition in a -- cgit v1.2.3 From cdf9811d24b9c857cb79e0ddd38181862ec34bd3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 3 Oct 2019 22:54:28 +0200 Subject: gexp: 'load-path-expression' produces an expression that deletes duplicates. Fixes . "herd eval root '(length %load-path)'" on a freshly-booted bare-bones system now returns 8 instead of 119 before. * guix/gexp.scm (load-path-expression): Rewrite expression to that it deletes duplicates. --- guix/gexp.scm | 49 +++++++++++++++++++++++++++++++------------------ 1 file changed, 31 insertions(+), 18 deletions(-) (limited to 'guix/gexp.scm') diff --git a/guix/gexp.scm b/guix/gexp.scm index e788fc5981..26881ce16c 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1527,24 +1527,37 @@ are searched for in PATH. Return #f when MODULES and EXTENSIONS are empty." #:module-path path #:system system #:target target))) - (return (gexp (eval-when (expand load eval) - (set! %load-path - (cons (ungexp modules) - (append (map (lambda (extension) - (string-append extension - "/share/guile/site/" - (effective-version))) - '((ungexp-native-splicing extensions))) - %load-path))) - (set! %load-compiled-path - (cons (ungexp compiled) - (append (map (lambda (extension) - (string-append extension - "/lib/guile/" - (effective-version) - "/site-ccache")) - '((ungexp-native-splicing extensions))) - %load-compiled-path))))))))) + (return + (gexp (eval-when (expand load eval) + ;; Augment the load paths and delete duplicates. Do that + ;; without loading (srfi srfi-1) or anything. + (let ((extensions '((ungexp-native-splicing extensions))) + (prepend (lambda (items lst) + ;; This is O(N²) but N is typically small. + (let loop ((items items) + (lst lst)) + (if (null? items) + lst + (loop (cdr items) + (cons (car items) + (delete (car items) lst)))))))) + (set! %load-path + (prepend (cons (ungexp modules) + (map (lambda (extension) + (string-append extension + "/share/guile/site/" + (effective-version))) + extensions)) + %load-path)) + (set! %load-compiled-path + (prepend (cons (ungexp compiled) + (map (lambda (extension) + (string-append extension + "/lib/guile/" + (effective-version) + "/site-ccache")) + extensions)) + %load-compiled-path))))))))) (define* (gexp->script name exp #:key (guile (default-guile)) -- cgit v1.2.3