Unstaged
modified   .dir-locals.el
@@ -72,6 +72,7 @@
    (eval . (put 'run-with-state 'scheme-indent-function 1))
    (eval . (put 'wrap-program 'scheme-indent-function 1))
    (eval . (put 'with-imported-modules 'scheme-indent-function 1))
+   (eval . (put 'let-system 'scheme-indent-function 1))
 
    (eval . (put 'call-with-container 'scheme-indent-function 1))
    (eval . (put 'container-excursion 'scheme-indent-function 1))
modified   gnu/services.scm
@@ -25,7 +25,8 @@
   #:use-module (guix profiles)
   #:use-module (guix sets)
   #:use-module (guix ui)
-  #:use-module ((guix utils) #:select (source-properties->location))
+  #:use-module ((guix utils) #:select (%current-target-system
+                                       source-properties->location))
   #:use-module (guix modules)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
@@ -265,6 +266,7 @@ This is a shorthand for (map (lambda (svc) ...) %base-services)."
 (define (system-derivation mentries mextensions)
   "Return as a monadic value the derivation of the 'system' directory
 containing the given entries."
+  (pk 'sysdrv (%current-target-system))
   (mlet %store-monad ((entries    mentries)
                       (extensions (sequence %store-monad mextensions)))
     (lower-object
modified   guix/gexp.scm
@@ -32,6 +32,7 @@
   #:export (gexp
             gexp?
             with-imported-modules
+            let-system
 
             gexp-input
             gexp-input?
@@ -167,7 +168,9 @@ returns its output file name of OBJ's OUTPUT."
     ((? derivation? drv)
      (derivation->output-path drv output))
     ((? string? file)
-     file)))
+     file)
+    (#f
+     thing)))
 
 (define (register-compiler! compiler)
   "Register COMPILER as a gexp compiler."
@@ -234,6 +237,51 @@ The expander specifies how an object is converted to its sexp representation."
     (return drv)))
 
 
+;;;
+;;; System dependencies.
+;;;
+
+;; Binding form for the current system and cross-compilation target.
+(define-record-type <system-binding>
+  (system-binding proc)
+  system-binding?
+  (proc system-binding-proc))
+
+(define-syntax let-system
+  (syntax-rules ()
+    "Introduce a system binding in a gexp.  The simplest form is:
+
+  (let-system system
+    (cond ((string=? system \"x86_64-linux\") ...)
+          (else ...)))
+
+which binds SYSTEM to the currently targeted system.  The second form is
+similar, but it also shows the cross-compilation target:
+
+  (let-system (system target)
+    ...)
+
+Here TARGET is bound to the cross-compilation triplet or #f."
+    ((_ (system target) exp0 exp ...)
+     (system-binding (lambda (system target)
+                       exp0 exp ...)))
+    ((_ system exp0 exp ...)
+     (system-binding (lambda (system target)
+                       exp0 exp ...)))))
+
+(define-gexp-compiler (system-binding-compiler (binding <system-binding>)
+                                               system target)
+  (match binding
+    (($ <system-binding> proc)
+     (let ((obj (proc system target)))
+       (match (and (struct? obj) (lookup-compiler obj))
+         (#f
+          (with-monad %store-monad
+            (return obj)))
+         (lower
+          (lower obj system #:target target)))))))
+
+
 ;;;
 ;;; File declarations.
 ;;;
@@ -485,14 +533,16 @@ corresponding input list as a monadic value.  When TARGET is true, use it as
 the cross-compilation target triplet."
   (with-monad %store-monad
     (sequence %store-monad
-              (map (match-lambda
-                     (((? struct? thing) sub-drv ...)
-                      (mlet %store-monad ((drv (lower-object
-                                                thing system #:target target)))
-                        (return `(,drv ,@sub-drv))))
-                     (input
-                      (return input)))
-                   inputs))))
+              (filter-map (match-lambda
+                            (((? struct? thing) sub-drv ...)
+                             (mlet %store-monad ((drv (lower-object
+                                                       thing system #:target target)))
+                               (if drv
+                                   (return `(,drv ,@sub-drv))
+                                   (return #f))))
+                            (input
+                             (return input)))
+                          inputs))))
 
 (define* (lower-reference-graphs graphs #:key system target)
   "Given GRAPHS, a list of (FILE-NAME INPUT ...) lists for use as a
@@ -817,6 +867,51 @@ environment."
                          (identifier-syntax modules)))
     body ...))
 
+;; (define-syntax alpha-rename
+;;   (syntax-rules (lambda begin)
+;;     ((_ (lambda (bindings ...) body ...) (env ...))
+;;      (lambda (y ...)
+;;        (alpha-rename (begin body ...)
+;;                      ((bindings ...) env ...))))
+;;     ((_ (begin exp ...) (env ...))
+;;      (begin (alpha-rename exp (env ...)) ...))
+;;     ((_ id (env ...))
+;;      (letrec-syntax ((lookup (syntax-rules (id)
+;;                                ((_ ((id alpha) _ (... ...)))
+;;                                 alpha)
+;;                                ((_ (_ rest (... ...)))
+;;                                 (lookup (rest (... ...))))
+;;                                ((_ ())
+;;                                 id))))
+;;        (lookup (env ...))))))
+
+(define-syntax alpha-rename
+  (lambda (s)
+    (syntax-case s (lambda begin)
+      ((_ (lambda (bindings ...) body ...) (env ...))
+       (with-syntax (((formals ...)
+                      (generate-temporaries #'(bindings ...))))
+         #'(lambda (formals ...)
+             (alpha-rename (begin body ...)
+                           (((bindings formals) ...) env ...)))))
+      ((_ (begin exp ...) (env ...))
+       #'(begin (alpha-rename exp (env ...)) ...))
+      ((_ (proc arg ...) (env ...))
+       #'((alpha-rename proc (env ...))
+          (alpha-rename arg (env ...))
+          ...))
+      ((_ id (env ...))
+       (identifier? (pk #'(env ...) #'id))
+       #'(letrec-syntax ((lookup (syntax-rules (id)
+                                   ((_ ((id alpha) _ (... ...)))
+                                    alpha)
+                                   ((_ (_ rest (... ...)))
+                                    (lookup (rest (... ...))))
+                                   ((_ ())
+                                    id))))
+           (lookup (env ...)))))))
+
+
 (define-syntax gexp
   (lambda (s)
     (define (collect-escapes exp)
modified   guix/profiles.scm
@@ -1211,7 +1211,8 @@ the entries in MANIFEST."
                              (hooks %default-profile-hooks)
                              (locales? #t)
                              (allow-collisions? #f)
-                             system target)
+                             system
+                             (target (%current-target-system)))
   "Return a derivation that builds a profile (aka. 'user environment') with
 the given MANIFEST.  The profile includes additional derivations returned by
 the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc.
modified   guix/scripts/system.scm
@@ -931,7 +931,8 @@ resulting from command-line parsing."
                              #:install-bootloader? bootloader?
                              #:target target #:device device
                              #:gc-root (assoc-ref opts 'gc-root)))))
-        #:system system))))
+        #:system system
+        #:target "arm-linux-gnueabihf"))))
 
 (define (process-command command args opts)
   "Process COMMAND, one of the 'guix system' sub-commands.  ARGS is its
@@ -1010,15 +1011,15 @@ argument list and OPTS is the option alist."
            (fail))))
       args))
 
-  (with-error-handling
-    (let* ((opts     (parse-command-line args %options
-                                         (list %default-options)
-                                         #:argument-handler
-                                         parse-sub-command))
-           (args     (option-arguments opts))
-           (command  (assoc-ref opts 'action)))
-      (parameterize ((%graft? (assoc-ref opts 'graft?)))
-        (process-command command args opts)))))
+  (let* ((opts     (parse-command-line args %options
+                                       (list %default-options)
+                                       #:argument-handler
+                                       parse-sub-command))
+         (args     (option-arguments opts))
+         (command  (assoc-ref opts 'action)))
+    (parameterize ((%graft? (assoc-ref opts 'graft?))
+                   (%current-target-system "arm-linux-gnueabihf"))
+      (process-command command args opts))))
 
 ;;; Local Variables:
 ;;; eval: (put 'call-with-service-upgrade-info 'scheme-indent-function 1)
modified   guix/store.scm
@@ -1136,18 +1136,24 @@ topological order."
   boolean)
 
 (define substitutable-paths
-  (operation (query-substitutable-paths (store-path-list paths))
-             "Return the subset of PATHS that is substitutable."
-             store-path-list))
+  (let ((proc (operation (query-substitutable-paths (store-path-list paths))
+                         "Return the subset of PATHS that is substitutable."
+                         store-path-list)))
+    (lambda (store lst)
+      (pk 's-p lst)
+      (proc store lst))))
 
 (define substitutable-path-info
-  (operation (query-substitutable-path-infos (store-path-list paths))
-             "Return information about the subset of PATHS that is
+  (let ((proc (operation (query-substitutable-path-infos (store-path-list paths))
+                         "Return information about the subset of PATHS that is
 substitutable.  For each substitutable path, a `substitutable?' object is
 returned; thus, the resulting list can be shorter than PATHS.  Furthermore,
 that there is no guarantee that the order of the resulting list matches the
 order of PATHS."
-             substitutable-path-list))
+                         substitutable-path-list)))
+    (lambda (store lst)
+      (pk 'subst-p-i lst)
+      (proc store lst))))
 
 (define built-in-builders
   (let ((builders (operation (built-in-builders)
@@ -1428,7 +1434,8 @@ where FILE is the entry's absolute file name and STAT is the result of
 (define* (run-with-store store mval
                          #:key
                          (guile-for-build (%guile-for-build))
-                         (system (%current-system)))
+                         (system (%current-system))
+                         target)
   "Run MVAL, a monadic value in the store monad, in STORE, an open store
 connection, and return the result."
   ;; Initialize the dynamic bindings here to avoid bad surprises.  The
@@ -1436,7 +1443,7 @@ connection, and return the result."
   ;; bind-time and not at call time, which can be disconcerting.
   (parameterize ((%guile-for-build guile-for-build)
                  (%current-system system)
-                 (%current-target-system #f))
+                 (%current-target-system target))
     (call-with-values (lambda ()
                         (run-with-state mval store))
       (lambda (result store)
modified   tests/gexp.scm
@@ -258,6 +258,23 @@
            (((thing "out"))
             (eq? thing file))))))
 
+(test-assert "let-system"
+  (list `(begin ,(%current-system) #t) '() '())
+  (let ((exp  #~(begin
+                  #$(let-system system system)
+                  #t)))
+    (list (gexp->sexp* exp)
+          (gexp-inputs exp)
+          (gexp-native-inputs exp))))
+
+(test-assert "let-system, target"
+  (list `(begin ,(%current-system) #t))
+  (let ((exp #~(list #$@(let-system (system target)
+                          (list system target)))))
+    (list (gexp->sexp* exp)
+          (gexp-inputs exp)
+          (gexp-native-inputs exp))))
+
 (test-assert "ungexp + ungexp-native"
   (let* ((exp    (gexp (list (ungexp-native %bootstrap-guile)
                              (ungexp coreutils)