summaryrefslogtreecommitdiff
path: root/guix/combinators.scm
diff options
context:
space:
mode:
authorMaxim Cournoyer <maxim.cournoyer@gmail.com>2022-01-25 22:07:13 -0500
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2022-01-25 22:07:13 -0500
commit1a5302435ff0d2822b823f5a6fe01faa7a85c629 (patch)
treeac7810c88b560532f22d2bab2e59609cd7305c21 /guix/combinators.scm
parent3ff2ac4980dacf10087e4b42bd9fbc490591900c (diff)
parent070b8a893febd6e7d8b2b7c8c4dcebacf7845aa9 (diff)
Merge branch 'master' into staging.
With "conflicts" solved (all in favor of master except git) in: gnu/local.mk gnu/packages/databases.scm gnu/packages/glib.scm gnu/packages/gnome.scm gnu/packages/gnupg.scm gnu/packages/gnuzilla.scm gnu/packages/graphics.scm gnu/packages/gstreamer.scm gnu/packages/gtk.scm gnu/packages/linux.scm gnu/packages/machine-learning.scm gnu/packages/networking.scm gnu/packages/polkit.scm gnu/packages/pulseaudio.scm gnu/packages/rpc.scm gnu/packages/rust.scm gnu/packages/version-control.scm gnu/packages/w3m.scm
Diffstat (limited to 'guix/combinators.scm')
-rw-r--r--guix/combinators.scm50
1 files changed, 48 insertions, 2 deletions
diff --git a/guix/combinators.scm b/guix/combinators.scm
index 88ad09dbe6..261d6bb57e 100644
--- a/guix/combinators.scm
+++ b/guix/combinators.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2017, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
;;;
@@ -24,7 +24,9 @@
#:export (fold2
fold-tree
fold-tree-leaves
- compile-time-value))
+ compile-time-value
+ procedure-call-location
+ define-compile-time-procedure))
;;; Commentary:
;;;
@@ -100,4 +102,48 @@ evaluate to a simple datum."
(_ #`'#,(datum->syntax s val)))))))
v))))
+(define-syntax-parameter procedure-call-location
+ (lambda (s)
+ (syntax-violation 'procedure-call-location
+ "'procedure-call-location' may only be used \
+within 'define-compile-time-procedure'"
+ s)))
+
+(define-syntax-rule (define-compile-time-procedure (proc (arg pred) ...)
+ body ...)
+ "Define PROC as a macro such that, if every actual argument in a \"call\"
+matches PRED, then BODY is evaluated at macro-expansion time. BODY must
+return a single value in a type that has read syntax--e.g., numbers, strings,
+lists, etc.
+
+BODY can refer to 'procedure-call-location', which is bound to a source
+property alist corresponding to the call site.
+
+This macro is meant to be used primarily for small procedures that validate or
+process its arguments in a way that may be equally well performed at
+macro-expansion time."
+ (define-syntax proc
+ (lambda (s)
+ (define loc
+ #`(identifier-syntax
+ '#,(datum->syntax #'s (syntax-source s))))
+
+ (syntax-case s ()
+ ((_ arg ...)
+ (and (pred (syntax->datum #'arg)) ...)
+ (let ((arg (syntax->datum #'arg)) ...)
+ (syntax-parameterize ((procedure-call-location
+ (identifier-syntax (syntax-source s))))
+ body ...)))
+ ((_ actual (... ...))
+ #`((lambda (arg ...)
+ (syntax-parameterize ((procedure-call-location #,loc))
+ body ...))
+ actual (... ...)))
+ (id
+ (identifier? #'id)
+ #`(lambda (arg ...)
+ (syntax-parameterize ((procedure-call-location #,loc))
+ body ...)))))))
+
;;; combinators.scm ends here